diff --git a/.gitmodules b/.gitmodules index e051a463bd..45b400967d 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,3 +1,4 @@ [submodule "reg_tests/r-test"] path = reg_tests/r-test - url = https://github.com/OpenFAST/r-test.git \ No newline at end of file + url = https://github.com/OpenFAST/r-test.git + shallow = true diff --git a/cmake/OpenfastFortranOptions.cmake b/cmake/OpenfastFortranOptions.cmake index 127e1d8783..a362ee31bc 100644 --- a/cmake/OpenfastFortranOptions.cmake +++ b/cmake/OpenfastFortranOptions.cmake @@ -139,6 +139,10 @@ macro(set_fast_gfortran) set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS},--stack,${stack_size}") endif() + # Profiling + # set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -pg") + # set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} -pg") + check_f2008_features() endmacro(set_fast_gfortran) diff --git a/docs/OtherSupporting/AeroDyn/Fluid_Inertia_Added_Mass_Implementation_Plan.docx b/docs/OtherSupporting/AeroDyn/Fluid_Inertia_Added_Mass_Implementation_Plan.docx new file mode 100644 index 0000000000..61d4a373ce Binary files /dev/null and b/docs/OtherSupporting/AeroDyn/Fluid_Inertia_Added_Mass_Implementation_Plan.docx differ diff --git a/docs/OtherSupporting/AeroDyn/UMERC24-Poster.pdf b/docs/OtherSupporting/AeroDyn/UMERC24-Poster.pdf new file mode 100644 index 0000000000..2e3b42a108 Binary files /dev/null and b/docs/OtherSupporting/AeroDyn/UMERC24-Poster.pdf differ diff --git a/docs/source/user/aerodyn-aeroacoustics/example/AeroDyn.ipt b/docs/source/user/aerodyn-aeroacoustics/example/AeroDyn.ipt index a7a30ffc94..9b3b57e107 100644 --- a/docs/source/user/aerodyn-aeroacoustics/example/AeroDyn.ipt +++ b/docs/source/user/aerodyn-aeroacoustics/example/AeroDyn.ipt @@ -3,18 +3,15 @@ IEA Wind Task 37 land-based reference wind turbine ====== General Options =================================================== False Echo - Echo the input to ".AD.ech"? (flag) "default" DTAero - Time interval for aerodynamic calculations {or "default"} (s) -1 WakeMod - Type of wake/induction model (switch) {0=none, 1=BEMT} -2 AFAeroMod - Type of blade airfoil aerodynamics model (switch -0 TwrPotent - Type of tower influence on wind around the tower (switch) -0 TwrShadow - Type of tower influence on wind based on downstream tower shadow (switch) {0=none, 1=Powles model, 2=Eames model} +1 Wake_Mod - Wake/induction model (switch) {0=none, 1=BEMT, 3=OLAF} [Wake_Mod cannot be 2 or 3 when linearizing] +0 TwrPotent - Type tower influence on wind based on potential flow around the tower (switch) {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} +0 TwrShadow - Calculate tower influence on wind based on downstream tower shadow (switch) {0=none, 1=Powles model, 2=Eames model} False TwrAero - Calculate tower aerodynamic loads? (flag) -False FrozenWake - Assume frozen wake during linearization? (flag -False CavitCheck - Perform cavitation check? (flag) -False Buoyancy - Include buoyancy effects? (flag) +False CavitCheck - Perform cavitation check? (flag) [UA_Mod must be 0 when CavitCheck=true] False NacelleDrag - Include Nacelle Drag effects? (flag) -True CompAA - Flag to compute AeroAcoustics calculation -"AeroAcousticsInput.dat" AA_InputFile -====== Environmental Conditions ========================================== -"default" AirDens - Air density (kg/m^3) +True CompAA - Flag to compute AeroAcoustics calculation [used only when Wake_Mod = 1 or 2] +"AeroAcousticsInput.dat" AA_InputFile - AeroAcoustics input file [used only when CompAA=true] +====== Environmental Conditions =================================================================== +"default" AirDens - Air density (kg/m^3) File continues... diff --git a/docs/source/user/aerodyn/appendix.rst b/docs/source/user/aerodyn/appendix.rst index ef7a0fbd09..173f84042d 100644 --- a/docs/source/user/aerodyn/appendix.rst +++ b/docs/source/user/aerodyn/appendix.rst @@ -21,11 +21,11 @@ to vary with time. This feature can be useful for debugging the aerodynamic resp outside of OpenFAST. 2) Multi-rotor AeroDyn Driver Input File -:download:`(driver input file example) `: +:download:`(driver input file example) ` 3) AeroDyn Primary Input File -:download:`(primary input file example) `: +:download:`(primary input file example) ` The primary AeroDyn input file defines modeling options, environmental conditions (except freestream flow), airfoils, tower nodal discretization and properties, tower, hub, and nacelle properties, as well as output file specifications. @@ -35,14 +35,14 @@ The input file begins with two lines of header information which is for your use 4) Airfoil Data Input File -:download:`(profile data) `: +:download:`(profile data) ` -:download:`(profile coordinates) `: +:download:`(profile coordinates) ` The airfoil data input files themselves (one for each airfoil) include tables containing coefficients of lift force, drag force, and pitching moment versus AoA, as well as UA model parameters. In these files, any line whose first non-blank character is an exclamation point (!) is ignored (for inserting comment lines). The non-comment lines should appear within the file in order, but comment lines may be intermixed as desired for reading clarity. 5) Blade Data Input File -:download:`(blade data input file example) `: +:download:`(blade data input file example) ` The blade data input file contains the nodal discretization, geometry, twist, chord, airfoil identifier, and buoyancy properties for a blade. Separate files are used for each blade, which permits modeling of aerodynamic imbalances. diff --git a/docs/source/user/aerodyn/driver.rst b/docs/source/user/aerodyn/driver.rst index dec9b71aa3..23577f3a34 100644 --- a/docs/source/user/aerodyn/driver.rst +++ b/docs/source/user/aerodyn/driver.rst @@ -118,6 +118,21 @@ An example of inputs is given below: +**SeaState data** + +SeaState can be called by the AeroDyn driver to define a wave field as part of the inflow information. +For MHK turbines with waves and currents, SeaState will query InflowWind and sum the velocities and +accelerations from the wave and current fields. If SeaState is activated, InflowWind must also be +activated, though the current can be set to 0 if desired. An example of inputs for this section is given below: + +.. code:: + + ----- SeaState Data --------------------------------------------------------------------- + 1 CompSeaSt - Compute wave velocities (switch) {0=No Waves; 1=SeaState} + "MHK_RM1_Floating_SeaState.dat" SeaStFile - Name of the SeaState input file [used only when CompSeaSt=1] + + + **Turbine data** The user specifies the number of turbines as follows: @@ -381,19 +396,19 @@ An example is given below for two turbines: .. code:: - ====== Hub Properties ============================================================================== [used only when Buoyancy=True] + ====== Hub Properties ============================================================================== [used only when MHK=1 or 2] 7.0 VolHub - Hub volume (m^3) 0.0 HubCenBx - Hub center of buoyancy x direction offset (m) - ====== Hub Properties ============================================================================== [used only when Buoyancy=True] + ====== Hub Properties ============================================================================== [used only when MHK=1 or 2] 5.0 VolHub - Hub volume (m^3) 0.2 HubCenBx - Hub center of buoyancy x direction offset (m) - ====== Nacelle Properties ========================================================================== [used only when Buoyancy=True or NacelleDrag=True] + ====== Nacelle Properties ========================================================================== [used only when MHK=1 or 2 or when NacelleDrag=True] 32.0 VolNac - Nacelle volume (m^3) 0.3, 0.0, 0.05 NacCenB - Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates (m) 4.67, 20.15, 20.15 NacArea - Projected area of the nacelle in X, Y, Z in the nacelle coordinate system (m^2) 0.5, 0.5, 0.5 NacCd - Drag coefficient for the nacelle areas defined above (-) 0.43, 0, 0 NacDragAC - Position of aerodynamic center of nacelle drag in nacelle coordinates (m) - ====== Nacelle Properties ========================================================================== [used only when Buoyancy=True or NacelleDrag=True] + ====== Nacelle Properties ========================================================================== [used only when MHK=1 or 2 or when NacelleDrag=True] 32.0 VolNac - Nacelle volume (m^3) 0.3, 0.0, 0.05 NacCenB - Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates (m) 4.67, 20.15, 20.15 NacArea - Projected area of the nacelle in X, Y, Z in the nacelle coordinate system (m^2) @@ -412,14 +427,14 @@ An example is given below for two turbines: .. code:: - ====== Turbine(1) Tower Influence and Aerodynamics ================================================ [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True] - 2 NumTwrNds - Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True] + ====== Turbine(1) Tower Influence and Aerodynamics ================================================ [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2] + 2 NumTwrNds - Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2] TwrElev TwrDiam TwrCd TwrTI TwrCb (m) (m) (-) (-) (-) 0.0 2.0 1.0 0.1 0.0 10.0 1.0 1.0 0.1 0.0 - ====== Turbine(2) Tower Influence and Aerodynamics ================================================ [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True] - 3 NumTwrNds - Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True] + ====== Turbine(2) Tower Influence and Aerodynamics ================================================ [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2] + 3 NumTwrNds - Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2] TwrElev TwrDiam TwrCd TwrTI TwrCb (m) (m) (-) (-) (-) 0.0 4.0 1.0 0.1 0.0 @@ -466,13 +481,16 @@ An example of an AeroDyn driver for a basic inflow, basic HAWT, and combined cas 1.700000000000000e+03 Pvap - Vapour pressure of working fluid (Pa) [used only for an MHK turbine cavitation check] 0 WtrDpth - Water depth (m) ----- Inflow Data ----------------------------------------------------------------------- - 0 CompInflow - Compute inflow wind velocities (switch) {0=Steady Wind; 1=InflowWind} - "unused" InflowFile - Name of the InflowWind input file [used only when CompInflow=1] - 9.0 HWindSpeed - Horizontal wind speed [used only when CompInflow=0 and AnalysisType=1] (m/s) - 140 RefHt - Reference height for horizontal wind speed [used only when CompInflow=0] (m) - 0.10 PLExp - Power law exponent [used only when CompInflow=0 and AnalysisType=1] (-) + 0 CompInflow - Compute inflow wind velocities (switch) {0=Steady Wind; 1=InflowWind} + "unused" InflowFile - Name of the InflowWind input file [used only when CompInflow=1] + 9.0 HWindSpeed - Horizontal wind speed [used only when CompInflow=0 and AnalysisType=1] (m/s) + 140 RefHt - Reference height for horizontal wind speed [used only when CompInflow=0] (m) + 0.10 PLExp - Power law exponent [used only when CompInflow=0 and AnalysisType=1] (-) + ----- SeaState Data --------------------------------------------------------------------- + 0 CompSeaSt - Compute wave velocities (switch) {0=No Waves; 1=SeaState} + "unused" SeaStFile - Name of the SeaState input file [used only when CompSeaSt=1] ----- Turbine Data ---------------------------------------------------------------------- - 1 NumTurbines - Number of turbines + 1 NumTurbines - Number of turbines ----- Turbine(1) Geometry --------------------------------------------------------------- True BasicHAWTFormat(1) - Flag to switch between basic or generic input format {True: next 7 lines are basic inputs, False: Base/Twr/Nac/Hub/Bld geometry and motion must follow} 0,0,0 BaseOriginInit(1) - Coordinate of tower base in base coordinates (m) diff --git a/docs/source/user/aerodyn/examples/ad_blade_example.dat b/docs/source/user/aerodyn/examples/ad_blade_example.dat index 80522dec0b..25e1435dce 100644 --- a/docs/source/user/aerodyn/examples/ad_blade_example.dat +++ b/docs/source/user/aerodyn/examples/ad_blade_example.dat @@ -2,29 +2,29 @@ Description line for this file -- file corresponds to inputs in Test01_UAE_AeroDyn.dat ====== Blade Properties ================================================================= 23 NumBlNds - Number of blade nodes used in the analysis (-) - BlSpn BlCrvAC BlSwpAC BlCrvAng BlTwist BlChord BlAFID BlCb BlCenBn BlCenBt - (m) (m) (m) (deg) (deg) (m) (-) (-) (m) (m) - 0.0 0.0 0.0 0.0 0.000 0.219 1 0.0 0.0 0.0 - 0.1360 0.0 0.0 0.0 0.000 0.219 1 0.0 0.0 0.0 - 0.4481 0.0 0.0 0.0 -0.098 0.181 1 0.0 0.0 0.0 - 0.8001 0.0 0.0 0.0 19.423 0.714 3 0.0 0.0 0.0 - 1.0767 0.0 0.0 0.0 14.318 0.711 4 0.0 0.0 0.0 - 1.2779 0.0 0.0 0.0 10.971 0.691 5 0.0 0.0 0.0 - 1.4958 0.0 0.0 0.0 8.244 0.668 6 0.0 0.0 0.0 - 1.7137 0.0 0.0 0.0 6.164 0.647 7 0.0 0.0 0.0 - 1.9149 0.0 0.0 0.0 4.689 0.627 7 0.0 0.0 0.0 - 2.1160 0.0 0.0 0.0 3.499 0.606 8 0.0 0.0 0.0 - 2.3340 0.0 0.0 0.0 2.478 0.584 8 0.0 0.0 0.0 - 2.5520 0.0 0.0 0.0 1.686 0.561 8 0.0 0.0 0.0 - 2.7530 0.0 0.0 0.0 1.115 0.542 8 0.0 0.0 0.0 - 2.9542 0.0 0.0 0.0 0.666 0.522 8 0.0 0.0 0.0 - 3.1721 0.0 0.0 0.0 0.267 0.499 8 0.0 0.0 0.0 - 3.3900 0.0 0.0 0.0 -0.079 0.478 8 0.0 0.0 0.0 - 3.5912 0.0 0.0 0.0 -0.381 0.457 9 0.0 0.0 0.0 - 3.7924 0.0 0.0 0.0 -0.679 0.437 9 0.0 0.0 0.0 - 3.9684 0.0 0.0 0.0 -0.933 0.419 9 0.0 0.0 0.0 - 4.1444 0.0 0.0 0.0 -1.184 0.401 10 0.0 0.0 0.0 - 4.3456 0.0 0.0 0.0 -1.466 0.381 10 0.0 0.0 0.0 - 4.5216 0.0 0.0 0.0 -1.711 0.363 10 0.0 0.0 0.0 - 4.5970 0.0 0.0 0.0 -1.711 0.363 10 0.0 0.0 0.0 + BlSpn BlCrvAC BlSwpAC BlCrvAng BlTwist BlChord BlAFID t_c BlCb BlCenBn BlCenBt BlCpn BlCpt BlCan BlCat BlCam + (m) (m) (m) (deg) (deg) (m) (-) (-) (-) (m) (m) (-) (-) (-) (-) (-) + 0.0 0.0 0.0 0.0 0.000 0.219 1 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 0.1360 0.0 0.0 0.0 0.000 0.219 1 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 0.4481 0.0 0.0 0.0 -0.098 0.181 1 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 0.8001 0.0 0.0 0.0 19.423 0.714 3 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 1.0767 0.0 0.0 0.0 14.318 0.711 4 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 1.2779 0.0 0.0 0.0 10.971 0.691 5 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 1.4958 0.0 0.0 0.0 8.244 0.668 6 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 1.7137 0.0 0.0 0.0 6.164 0.647 7 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 1.9149 0.0 0.0 0.0 4.689 0.627 7 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 2.1160 0.0 0.0 0.0 3.499 0.606 8 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 2.3340 0.0 0.0 0.0 2.478 0.584 8 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 2.5520 0.0 0.0 0.0 1.686 0.561 8 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 2.7530 0.0 0.0 0.0 1.115 0.542 8 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 2.9542 0.0 0.0 0.0 0.666 0.522 8 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 3.1721 0.0 0.0 0.0 0.267 0.499 8 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 3.3900 0.0 0.0 0.0 -0.079 0.478 8 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 3.5912 0.0 0.0 0.0 -0.381 0.457 9 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 3.7924 0.0 0.0 0.0 -0.679 0.437 9 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 3.9684 0.0 0.0 0.0 -0.933 0.419 9 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 4.1444 0.0 0.0 0.0 -1.184 0.401 10 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 4.3456 0.0 0.0 0.0 -1.466 0.381 10 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 4.5216 0.0 0.0 0.0 -1.711 0.363 10 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 4.5970 0.0 0.0 0.0 -1.711 0.363 10 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 diff --git a/docs/source/user/aerodyn/examples/ad_driver_example.dvr b/docs/source/user/aerodyn/examples/ad_driver_example.dvr index c93fcfe122..35c27d5f59 100644 --- a/docs/source/user/aerodyn/examples/ad_driver_example.dvr +++ b/docs/source/user/aerodyn/examples/ad_driver_example.dvr @@ -20,6 +20,9 @@ False Echo - Echo input parameters to ".ech"? 9.0 HWindSpeed - Horizontal wind speed [used only when CompInflow=0 and AnalysisType=1] (m/s) 140 RefHt - Reference height for horizontal wind speed [used only when CompInflow=0] (m) 0.10 PLExp - Power law exponent [used only when CompInflow=0 and AnalysisType=1] (-) +----- SeaState Data [used only when MHK = 1 or 2] --------------------------------------- + 0 CompSeaSt - Compute wave velocities (switch) {0=No Waves; 1=SeaState} +"unused" SeaStFile - Name of the SeaState input file [used only when CompSeaSt=1] ----- Turbine Data ---------------------------------------------------------------------- 1 NumTurbines - Number of turbines ----- Turbine(1) Geometry --------------------------------------------------------------- diff --git a/docs/source/user/aerodyn/examples/ad_driver_multiple.dvr b/docs/source/user/aerodyn/examples/ad_driver_multiple.dvr index 00cf198871..8cd074dfe0 100644 --- a/docs/source/user/aerodyn/examples/ad_driver_multiple.dvr +++ b/docs/source/user/aerodyn/examples/ad_driver_multiple.dvr @@ -20,6 +20,9 @@ False Echo - Echo input parameters to ".ech"? 10 HWindSpeed - Horizontal wind speed [used only when CompInflow=0 and AnalysisType=1] (m/s) 200 RefHt - Reference height for horizontal wind speed [used only when CompInflow=0] (m) 0 PLExp - Power law exponent [used only when CompInflow=0 and AnalysisType=1] (-) +----- SeaState Data [used only when MHK = 1 or 2] --------------------------------------- + 0 CompSeaSt - Compute wave velocities (switch) {0=No Waves; 1=SeaState} +"unused" SeaStFile - Name of the SeaState input file [used only when CompSeaSt=1] ----- Turbine Data ---------------------------------------------------------------------- 2 NumTurbines - Number of turbines ----- Turbine(1) ------------------------------------------------------------------------ diff --git a/docs/source/user/aerodyn/examples/ad_primary_example.dat b/docs/source/user/aerodyn/examples/ad_primary_example.dat index 6505544349..9199db451f 100644 --- a/docs/source/user/aerodyn/examples/ad_primary_example.dat +++ b/docs/source/user/aerodyn/examples/ad_primary_example.dat @@ -8,7 +8,6 @@ False Echo - Echo the input to ".AD.ech"? (flag 0 TwrShadow - Calculate tower influence on wind based on downstream tower shadow (switch) {0=none, 1=Powles model, 2=Eames model} False TwrAero - Calculate tower aerodynamic loads? (flag) False CavitCheck - Perform cavitation check? (flag) [UA_Mod must be 0 when CavitCheck=true] -False Buoyancy - Include buoyancy effects? (flag) False NacelleDrag - Include Nacelle Drag effects? (flag) False CompAA - Flag to compute AeroAcoustics calculation [used only when Wake_Mod = 1 or 2] "unused" AA_InputFile - AeroAcoustics input file [used only when CompAA=true] @@ -74,10 +73,10 @@ True UseBlCm - Include aerodynamic pitching moment in calcul "Test01_UAE_AeroDyn_blade.dat" ADBlFile(1) - Name of file containing distributed aerodynamic properties for Blade #1 (-) "Test01_UAE_AeroDyn_blade.dat" ADBlFile(2) - Name of file containing distributed aerodynamic properties for Blade #2 (-) [unused if NumBl < 2] "Test01_UAE_AeroDyn_blade.dat" ADBlFile(3) - Name of file containing distributed aerodynamic properties for Blade #3 (-) [unused if NumBl < 3] -====== Hub Properties ============================================================================== [used only when Buoyancy=True] +====== Hub Properties ============================================================================== [used only when MHK=1 or 2] 0 VolHub - Hub volume (m^3) 0 HubCenBx - Hub center of buoyancy x direction offset (m) -====== Nacelle Properties ========================================================================== [used only when Buoyancy=True or NacelleDrag=True] +====== Nacelle Properties ========================================================================== [used only when MHK=1 or 2 or when NacelleDrag=True] 0 VolNac - Nacelle volume (m^3) 0, 0, 0 NacCenB - Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates (m) 0, 0, 0 NacArea - Projected area of the nacelle in X, Y, Z in the nacelle coordinate system (m^2) @@ -86,15 +85,15 @@ True UseBlCm - Include aerodynamic pitching moment in calcul ====== Tail Fin Aerodynamics ======================================================================= False TFinAero - Calculate tail fin aerodynamics model (flag) "unused" TFinFile - Input file for tail fin aerodynamics [used only when TFinAero=True] -====== Tower Influence and Aerodynamics ============================================================ [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True] - 5 NumTwrNds - Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True] -TwrElev TwrDiam TwrCd TwrTI TwrCb ! TwrTI used only when TwrShadow=2; TwrCb used only when Buoyancy=True -(m) (m) (-) (-) (-) -0.0000000E+00 6.0000000E+00 0.0000000E+00 1.0000000E-01 0.0000000E+00 -2.0000000E+01 5.5000000E+00 0.0000000E+00 1.0000000E-01 0.0000000E+00 -4.0000000E+01 5.0000000E+00 0.0000000E+00 1.0000000E-01 0.0000000E+00 -6.0000000E+01 4.5000000E+00 0.0000000E+00 1.0000000E-01 0.0000000E+00 -8.0000000E+01 4.0000000E+00 0.0000000E+00 1.0000000E-01 0.0000000E+00 +====== Tower Influence and Aerodynamics ============================================================ [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2] + 5 NumTwrNds - Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2] +TwrElev TwrDiam TwrCd TwrTI TwrCb TwrCp TwrCa !TwrTI used only with TwrShadow=2, TwrCb/TwrCp/TwrCa used only with MHK=1 or 2 +(m) (m) (-) (-) (-) (-) (-) +0.0000000E+00 6.0000000E+00 0.0000000E+00 1.0000000E-01 0.0000000E+00 0.0000000E+00 0.0000000E+00 +2.0000000E+01 5.5000000E+00 0.0000000E+00 1.0000000E-01 0.0000000E+00 0.0000000E+00 0.0000000E+00 +4.0000000E+01 5.0000000E+00 0.0000000E+00 1.0000000E-01 0.0000000E+00 0.0000000E+00 0.0000000E+00 +6.0000000E+01 4.5000000E+00 0.0000000E+00 1.0000000E-01 0.0000000E+00 0.0000000E+00 0.0000000E+00 +8.0000000E+01 4.0000000E+00 0.0000000E+00 1.0000000E-01 0.0000000E+00 0.0000000E+00 0.0000000E+00 ====== Outputs ==================================================================================== True SumPrint - Generate a summary file listing input options and interpolated properties to ".AD.sum"? (flag) 4 NBlOuts - Number of blade node outputs [0 - 9] (-) diff --git a/docs/source/user/aerodyn/index.rst b/docs/source/user/aerodyn/index.rst index 7b414b4b28..534698a649 100644 --- a/docs/source/user/aerodyn/index.rst +++ b/docs/source/user/aerodyn/index.rst @@ -1,3 +1,5 @@ +.. _AD_user_guide: + AeroDyn Users Guide and Theory Manual ====================================== @@ -16,6 +18,8 @@ can be downladed from the list below. - :download:`Development Plan for the Aerodynamic Linearization of OpenFAST <../../../OtherSupporting/AeroDyn/AeroLin_2019-12.pdf>` - :download:`AeroDyn Meshes and Related Calculations <../../../OtherSupporting/AeroDyn/AeroDynMesh_Rev4.docx>` - :download:`Calculation of Buoyancy on a Marine Hydrokinetic Turbine in AeroDyn <../../../OtherSupporting/AeroDyn/Buoyancy_Implementation_Plan_Rev11.docx>` +- :download:`Calculation of Fluid Inertia and Added Mass Loads on an MHK Turbine in AeroDyn <../../../OtherSupporting/AeroDyn/Fluid_Inertia_Added_Mass_Implementation_Plan.docx>` +- :download:`Determination of Added Mass Coefficients for Floating Hydrokinetic Turbine Blades using Computational Fluid Dynamics <../../../OtherSupporting/AeroDyn/UMERC24-Poster.pdf>` .. - :download:` ` diff --git a/docs/source/user/aerodyn/input.rst b/docs/source/user/aerodyn/input.rst index 000fc089fe..76323effa6 100644 --- a/docs/source/user/aerodyn/input.rst +++ b/docs/source/user/aerodyn/input.rst @@ -129,11 +129,6 @@ not function with unsteady airfoil aerodynamics. If ``CavitCheck`` is TRUE, the ``MHK`` flag in the AeroDyn or OpenFAST driver input file must be set to 1 or 2 to indicate an MHK turbine is being modeled. -Set the ``Buoyancy`` flag to TRUE to calculate buoyant loads on the blades, -tower, nacelle, and hub of an MHK turbine or FALSE to disable this calculation. -If ``Buoyancy`` is TRUE, the ``MHK`` flag in the AeroDyn or OpenFAST driver -input file must be set to 1 or 2 to indicate an MHK turbine is being modeled. - Set the ``NacelleDrag`` flag to TRUE to calculate the drag loads on the nacelle or FALSE to disable this calculation. @@ -431,7 +426,7 @@ pitching-moment coefficient data must be included in the airfoil data tables with ``InCol_Cm`` not equal to zero. The blade nodal discretization, geometry, twist, chord, airfoil -identifier, and buoyancy properties are set in separate input files for each +identifier, and buoyancy/added mass/fluid inertia properties are set in separate input files for each blade, described in :numref:`blade_data_input_file`. ``ADBlFile(1)`` is the filename for blade 1, ``ADBlFile(2)`` is the filename for blade 2, and ``ADBlFile(3)`` is the filename for blade 3, respectively; the latter is not @@ -443,19 +438,19 @@ permits modeling of aerodynamic imbalances. Hub Properties ~~~~~~~~~~~~~~ The input parameters in this section pertain to the calculation of buoyant loads -on the hub and are only used when ``Buoyancy = TRUE``. +on the hub. ``VolHub`` is the volume of the hub and ``HubCenBx`` is the x offset of the hub center of buoyancy from the hub center in local hub coordinates; offsets in the y and z directions are assumed to be zero. To neglect buoyant loads on the hub, set ``VolHub`` to 0. -Since the hub and blades are joined elements, hub buoyancy should be turned on if blade buoyancy is on, and vice versa. +Since the hub and blades are joined elements, hub buoyancy should be included if blade buoyancy is included, and vice versa. Nacelle Properties ~~~~~~~~~~~~~~~~~~ The input parameters in this section pertain to the calculation of buoyant and drag loads -on the nacelle and are only used when ``Buoyancy = TRUE`` or ``NacelleDrag = TRUE``. +on the nacelle and are only used when ``MHK > 0`` or ``NacelleDrag = TRUE``. ``VolNac`` is the volume of the nacelle and ``NacCenB``` is the position (x,y,z vector) of the nacelle center of buoyancy from @@ -492,8 +487,8 @@ Tower Influence and Aerodynamics ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The input parameters in this section pertain to the tower influence, tower drag, -and/or tower buoyancy calculations and are only used when ``TwrPotent`` > -0, ``TwrShadow`` > 0, ``TwrAero = TRUE``, or ``Buoyancy = TRUE``. +tower buoyancy, tower added mass, and/or tower fluid inertia calculations and are only used when ``TwrPotent`` > +0, ``TwrShadow`` > 0, ``TwrAero = TRUE``, ``MHK = 1``, or ``MHK = 2``. ``NumTwrNds`` is the user-specified number of tower analysis nodes and determines the number of rows in the subsequent table (after two table @@ -507,7 +502,9 @@ to MSL for offshore wind and floating MHK turbines or relative to the seabed for local tower drag-force coefficient, ``TwrTI`` specifies the turbulence intensity used in the Eames tower shadow model (``TwrShadow`` = 2) as a fraction (rather than a percentage) of the -wind fluctuation, and ``TwrCb`` specifies the tower buoyancy coefficient. +wind fluctuation, ``TwrCb`` specifies the tower buoyancy coefficient, +``TwrCp`` specifies the tower dynamic pressure coefficient, and +``TwrCa`` specifies the tower added mass coefficient. ``TwrElev`` must be entered in monotonically increasing order—from the lowest (tower-base) to the highest (tower-top) elevation. For floating MHK turbines with the tower below MSL, tower nodes should be entered as increasingly negative values, @@ -519,7 +516,9 @@ defined at each node as the cross-sectional area of the tower divided by the area of a circle with diameter equal to the characteristic length of the tower cross section (i.e., ``TwrDiam``). For towers with circular cross-sections, ``TwrCb`` will likely be 1.0 at each node. To neglect buoyant loads on the -tower, set ``TwrCb`` to 0. See :numref:`ad_tower_geom`. +tower, set ``TwrCb`` to 0. To neglect added mass loads on the +tower, set ``TwrCa`` to 0. To neglect fluid inertia loads on the +tower, set ``TwrCp`` to 0. See :numref:`ad_tower_geom`. .. _AD-Outputs: @@ -903,8 +902,9 @@ Blade Data Input File --------------------- The blade data input file contains the nodal discretization, geometry, -twist, chord, airfoil identifier, and buoyancy properties for a blade. Separate -files are used for each blade, which permits modeling of aerodynamic imbalances. +twist, chord, airfoil identifier, and buoyancy/added mass/fluid inertia +properties for a blade. Separate files are used for each blade, which +permits modeling of aerodynamic imbalances. A sample blade data input file is given in :numref:`ad_appendix`. The input file begins with two lines of header information which is for @@ -958,18 +958,37 @@ nodes. For each node: table in the AeroDyn primary input file); multiple blade nodes can use the same airfoil data; +- ``t_c`` specifies the blade thickness-to-chord ratio, used to calculate the + reference cross-sectional area for added mass and fluid inertia loads, cannot be less than 0; + - ``BlCb`` specifies the blade buoyancy coefficient, defined as the local cross-sectional area of the blade divided by the area of a circle with diameter equal to ``BlChord``; to neglect buoyant loads on the blade, - set ``BlCb`` to 0; since the blades and hub are joined elements, blade buoyancy should be turned on if hub buoyancy is on, and vice versa; + set ``BlCb`` to 0; since the blades and hub are joined elements, + blade buoyancy should be included if hub buoyancy is included, and vice versa; - ``BlCenBn`` specifies the offset of the blade center of buoyancy from the aerodynamic center in the direction normal to the chord (positive pointing - toward the suction side of the blade); and + toward the suction side of the blade); - ``BlCenBt`` specifies the offset of the blade center of buoyancy from the aerodynamic center in the direction tangential to the chord - (positive pointing toward the trailing edge of the blade). + (positive pointing toward the trailing edge of the blade); + +- ``BlCpn`` specifies the blade normal-to-chord dynamic pressure coefficient; + to neglect normal-to-chord fluid inertia loads on the blade, set ``BlCpn`` to 0; + +- ``BlCpt`` specifies the blade tangential-to-chord dynamic pressure coefficient; + to neglect tangential-to-chord fluid inertia loads on the blade, set ``BlCpt`` to 0; + +- ``BlCan`` specifies the blade normal-to-chord added mass coefficient, cannot be less than 0; + to neglect normal-to-chord added mass loads on the blade, set ``BlCan`` to 0; + +- ``BlCat`` specifies the blade tangential-to-chord added mass coefficient, cannot be less than 0; + to neglect tangential-to-chord added mass loads on the blade, set ``BlCat`` to 0; and + +- ``BlCam`` specifies the blade pitch added mass coefficient, cannot be less than 0; + to neglect pitch added mass loads on the blade, set ``BlCam`` to 0. See :numref:`ad_blade_geom`. Twist is shown in :numref:`ad_blade_local_cs` of :numref:`ad_appendix`. diff --git a/docs/source/user/aerodyn/introduction.rst b/docs/source/user/aerodyn/introduction.rst index d4f845f374..0aadd67e9d 100644 --- a/docs/source/user/aerodyn/introduction.rst +++ b/docs/source/user/aerodyn/introduction.rst @@ -14,13 +14,13 @@ However, the module equally applies to the hydrodynamics of marine hydrokinetic (MHK) turbines (the terms “wind turbine”, “tower”, “aerodynamics” etc. in this document imply “MHK turbine”, “MHK support structure”, “hydrodynamics” etc. for MHK turbines). Additional physics important for MHK turbines, not applicable to -wind turbines, computed by AeroDyn include a cavitation check and buoyant forces -and moments on the blades, tower, hub, and nacelle. This -documentation pertains version of AeroDyn in the OpenFAST github repository. -The AeroDyn version released of OpenFAST 1.0.0 is most closely related to -AeroDyn version 15 in the legacy version numbering. AeroDyn version 15 was a -complete overhaul from earlier version of AeroDyn. AeroDyn version 15 and newer -follows the requirements of the FAST modularization framework. +wind turbines, computed by AeroDyn include a cavitation check, buoyant forces +and moments on the blades, tower, hub, and nacelle, and added mass and inertia +forces and moments on the blades and tower. This documentation pertains to the version +of AeroDyn in the OpenFAST github repository. The AeroDyn version released with OpenFAST +1.0.0 is most closely related to AeroDyn version 15 in the legacy version numbering. +AeroDyn version 15 was a complete overhaul from earlier versions of AeroDyn. +AeroDyn version 15 and newer follow the requirements of the FAST modularization framework. AeroDyn calculates aerodynamic loads on both the blades and tower. Aerodynamic calculations within AeroDyn are based on the principles of @@ -67,14 +67,15 @@ and returns them back to OpenFAST as part of the aero-elastic calculation. In standalone mode, the inputs to AeroDyn are prescribed by a simple driver code, without aero-elastic coupling. -AeroDyn consists of six submodels: (1) rotor wake/induction, (2) blade +AeroDyn consists of seven submodels: (1) rotor wake/induction, (2) blade airfoil aerodynamics, (3) tower influence on the fluid local to the -blade nodes, (4) tower and nacelle drag, (5) aeroacoustics, -and (6) buoyancy on the blades, hub, nacelle, and tower (for MHK turbines). -Nacelle, hub, and tail-vane fluid influence and loading (with the exception -of nacelle and hub buoyant loads) and wake and array effects between -multiple turbines in a wind plant are not yet available in AeroDyn. -Aeroacoustics are not available for MHK turbines. +blade nodes, (4) tower and nacelle drag, (5) aeroacoustics, (6) buoyancy +on the blades, hub, nacelle, and tower (for MHK turbines), and (7) added +mass and fluid inertia on the blades and tower (for MHK turbines). Nacelle, hub, +and tail-vane fluid influence and loading (with the exception +of nacelle drag and nacelle and hub buoyant loads) and wake and array +effects between multiple turbines in a wind plant are not yet available +in AeroDyn. Aeroacoustics are not available for MHK turbines. For operating wind and MHK turbine rotors, AeroDyn calculates the influence of the wake via induction factors based on the quasi-steady diff --git a/docs/source/user/aerodyn/theory.rst b/docs/source/user/aerodyn/theory.rst index 8043c51cfe..737b5a0e7f 100644 --- a/docs/source/user/aerodyn/theory.rst +++ b/docs/source/user/aerodyn/theory.rst @@ -214,3 +214,82 @@ The buoyancy calculation for the hub and nacelle is completed according to the f 4. Move buoyant loads from the center of buoyancy to the aerodynamic center 5. For the hub, correct loads to account for the joints with each blade 6. For the nacelle, correct loads to account for the joint with the tower + +.. _AD_addedmass_inertia: + +Added Mass and Fluid Inertia +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Added mass loads are caused by body and fluid accelerations. +These forces can often be neglected in less dense fluids, such as air, but can be significant in denser +fluids, such as water. To capture the effects of these forces on MHK turbines, +added mass and fluid inertia loads are calculated for the turbine blades and tower. +Per-unit-length loads are estimated at each blade or tower node by calculating the added mass and fluid inertia +forces according to the appropriate terms from Morison's equation. The resulting loads are summed with the +previously calculated hydrodynamic and/or buoyant per-unit-length loads. +Loads for the blades are applied at the aerodynamic center. Loads for the tower are applied at the centerline. +Marine growth and end effects are neglected, and members are not allowed to cross the free surface +(i.e., members are always fully submerged). Ballast is not considered. Nodes do not need to be uniformly spaced, +and axial loads are neglected. The tower is assumed to be axisymmetric (with the same coefficients used in both transverse directions), +but the blade is not (with different coefficients normal and tangential to the chord, as well as an added mass coefficient for pitch). + +.. _AD_addedmass_inertia_Morison: + +Morison's Equation +------------------ +Added mass and fluid inertia loads are calculated according to the appropriate terms from Morison's equation. The added mass force is given as + +.. math:: + F_{a} = \rho C_a V (\dot{u} - \dot{v}) + +where :math:`\rho` is the fluid density, :math:`C_a` is the added mass coefficient, :math:`V` is the element volume, :math:`\dot{u}` is the +fluid acceleration, and :math:`\dot{v}` is the body acceleration. + +The fluid inertia force is given as + +.. math:: + F_{i} = \rho C_p V \dot{u} + +where :math:`C_p` is the dynamic pressure coefficient. + +The fluid density and added mass and dynamic pressure coeffcients are user-specified. Added mass and fluid +inertia loads can be turned off by setting the relevant coefficients to zero. Additional information about calculating added mass coefficients can be +found in :numref:`AD_user_guide` ("Determination of Added Mass Coefficients for Floating Hydrokinetic Turbine Blades using Computational Fluid Dynamics"). +The body and fluid accelerations are calculated internally and passed to AeroDyn. Body accelerations are available from the structural solver (or driver) +and fluid accelerations are calculated based on the inflow velocity time series. Added mass and fluid inertia loads are calculated as per-unit-length within +AeroDyn. Therefore, :math:`V` is taken as the cross-sectional area at the node of interest. For the blades, the reference cross-sectional area for the normal +and tangential terms is chord*thickness (:math:`ct`). This is expressed as :math:`(c^2)(t/c)`, where :math:`t/c` (i.e., ``t_c``) is specified +in the AeroDyn blade input file and cannot be less than 0. The reference cross-sectional area for the blade pitch term is XX (check 1/12 factor). +For the tower, the reference cross-sectional area is :math:`\pi r^2` where :math:`r` is calculated as (0.5 ``TwrDiam``). + +Blade Added Mass and Fluid Inertia +---------------------------------- +Added mass and fluid inertia loads are calculated for the normal-to-chord, tangential-to-chord, and pitch directions in the blade coordinate system. +The following coefficients are defined by the user in the AeroDyn blade input file: + +- ``BlCpn`` specifies the blade normal-to-chord dynamic pressure coefficient; + to neglect normal-to-chord fluid inertia loads on the blade, set ``BlCpn`` to 0 + +- ``BlCpt`` specifies the blade tangential-to-chord dynamic pressure coefficient; + to neglect tangential-to-chord fluid inertia loads on the blade, set ``BlCpt`` to 0 + +- ``BlCan`` specifies the blade normal-to-chord added mass coefficient, cannot be less than 0; + to neglect normal-to-chord added mass loads on the blade, set ``BlCan`` to 0 + +- ``BlCat`` specifies the blade tangential-to-chord added mass coefficient, cannot be less than 0; + to neglect tangential-to-chord added mass loads on the blade, set ``BlCat`` to 0 + +- ``BlCam`` specifies the blade pitch added mass coefficient, cannot be less than 0; + to neglect pitch added mass loads on the blade, set ``BlCam`` to 0 + +Tower Added Mass and Fluid Inertia +---------------------------------- +Added mass and fluid inertia loads are calculated for the transverse direction in the tower coordinate system. +The following coefficients are defined by the user in the AeroDyn primary input file: + +- ``TwrCp`` specifies the tower transverse dynamic pressure coefficient; + to neglect fluid inertia loads on the tower, set ``TwrCp`` to 0 + +- ``TwrCa`` specifies the tower transverse added mass coefficient, cannot be less than 0; + to neglect added mass loads on the tower, set ``TwrCa`` to 0 + diff --git a/docs/source/user/glue/modvar.dot b/docs/source/user/glue/modvar.dot new file mode 100644 index 0000000000..380b57089b --- /dev/null +++ b/docs/source/user/glue/modvar.dot @@ -0,0 +1,121 @@ +digraph UML_Class_diagram { + graph [fontname = "Helvetica,Arial,sans-serif"; rankdir = LR; ranksep = 1] + node [fontname = "Helvetica,Arial,sans-serif"; shape = record; style = filled; fillcolor = gray95] + edge [fontname = "Helvetica,Arial,sans-serif"] + + + + DatLoc [shape = plain;label = < + + + + + +
DatLoc
NumIntKi
i1IntKi
i2IntKi
i3IntKi
>] + + ModVarType [shape = plain;label = < + + + + + + + + + + + + + + + + + + +
ModVarType
Namecharacter
LinNames(:)character
DLDatLoc
FieldIntKi
NodesIntKi
NumIntKi
FlagsIntKi
DerivOrderIntKi
iLoc(2)IntKi
iGlu(2)IntKi
iLBIntKi
iUBIntKi
jIntKi
kIntKi
mIntKi
nIntKi
PerturbR8Ki
>] + + ModVarsType [shape = plain;label = < + + + + + + + + + +
ModVarsType
NxIntKi
x(:)ModVarType
NzIntKi
z(:)ModVarType
NuIntKi
u(:)ModVarType
NyIntKi
y(:)ModVarType
>] + + ModLinType [shape = plain;label = < + + + + + + + + + + + + + + + + +
ModLinType
Abbrcharacter
x(:)R8Ki
dx(:)R8Ki
z(:)R8Ki
u(:)R8Ki
y(:)R8Ki
J(:,:)R8Ki
dYdx(:,:)R8Ki
dXdx(:,:)R8Ki
dYdu(:,:)R8Ki
dXdu(:,:)R8Ki
dXdy(:,:)R8Ki
dUdu(:,:)R8Ki
dUdy(:,:)R8Ki
StateRotation(:,:)R8Ki
>] + + ModDataType [shape = plain;label = < + + + + + + + + + + + +
ModDataType
Abbrcharacter
IDIntKi
iModIntKi
InsIntKi
DTR8Ki
SubStepsIntKi
iSrcMap(:)IntKi
iDstMap(:)IntKi
VarsModVarsType
LinModLinType
>] + + ModGlueType [shape = plain;label = < + + + + + +
ModGlueType
Namecharacter
VarsModVarsType
Mods(:)ModDataType
LinModLinType
>] + + ModVarType:DatLoc:e -> DatLoc:header:w; + ModVarsType:x:e -> ModVarType:header:w; + ModVarsType:z:e -> ModVarType:header:w; + ModVarsType:u:e -> ModVarType:header:w; + ModVarsType:y:e -> ModVarType:header:w; + + ModDataType:Vars:e -> ModVarsType:header:w; + + ModDataType:Lin:e -> ModLinType:header:w; + + ModGlueType:Mods:e -> ModDataType:header:w; + ModGlueType:Lin:e -> ModLinType:header:w; + + + + ModJacType [shape = plain;label = < + + + + + + + + + + + + + +
ModJacType
Namecharacter
x(:)R8Ki
z(:)R8Ki
u(:)R8Ki
y(:)R8Ki
x_perturb(:)R8Ki
z_perturb(:)R8Ki
u_perturb(:)R8Ki
X_pos(:)R8Ki
X_neg(:)R8Ki
Y_pos(:)R8Ki
Y_neg(:)R8Ki
>] + +} diff --git a/docs/source/user/inflowwind/input.rst b/docs/source/user/inflowwind/input.rst index b2d9e97335..a44a084878 100644 --- a/docs/source/user/inflowwind/input.rst +++ b/docs/source/user/inflowwind/input.rst @@ -115,3 +115,28 @@ be performed in a different order than if both angles are specified in the same [U V W] = R(wind direction: InflowWind) * R(upflow: InflowWind) * R(wind direction: UniformWind) * R(upflow: UniformWind) * [u v w] +.. _inflow_superposition: + +Superposition of Wave and Current Inflow +======================================== +For MHK turbines, wave and current velocities and accelerations are superimposed (i.e., summed) such that all submerged components are exposed +to the same inflow field. Both AeroDyn and HydroDyn can query SeaState for wave field infomation. SeaState then queries InflowWind for the current +field, sums the velocities and accelerations, and returns the superimposed flow field information. This has several implications for modeling +MHK turbines, which are listed below. Note that dynamic pressure contributions from InflowWind are neglected. + +When modeling a rotor or rotor/tower only (i.e., hydrodynamics modeled in AeroDyn only): + +- SeaState must be used when defining a flow field with waves +- Current definition in SeaState must always be set to 0 +- If SeaState is activated, InflowWind must also be activated, though the current can be set to 0 +- InflowWind must be used when defining a flow field with currents +- For combined wave and current flow fields, SeaState will query InflowWind + +When modeling a rotor or rotor/tower and support structure (i.e., hydrodynamics modeled in AeroDyn and HydroDyn): + +- SeaState must always be used, even when defining a flow field with no waves +- Current definition in SeaState must always be set to 0 +- If SeaState is activated, InflowWind must also be activated, though the current can be set to 0 +- InflowWind must be used when defining a flow field with currents +- For current only cases, set the SeaState wave field to 0; current information will be passed through SeaState from InflowWind +- For combined wave and current flow fields, SeaState will query InflowWind \ No newline at end of file diff --git a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 index 983b960364..92d8947393 100644 --- a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 +++ b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 @@ -125,7 +125,22 @@ MODULE FASTWrapper_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AzimAvg_Cq !< Azimuthally averaged torque coefficient (normal to disk), distributed radially [-] END TYPE FWrap_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: FWrap_x_dummy = 1 ! FWrap%dummy + integer(IntKi), public, parameter :: FWrap_z_dummy = 2 ! FWrap%dummy + integer(IntKi), public, parameter :: FWrap_u_fromSCglob = 3 ! FWrap%fromSCglob + integer(IntKi), public, parameter :: FWrap_u_fromSC = 4 ! FWrap%fromSC + integer(IntKi), public, parameter :: FWrap_y_toSC = 5 ! FWrap%toSC + integer(IntKi), public, parameter :: FWrap_y_xHat_Disk = 6 ! FWrap%xHat_Disk + integer(IntKi), public, parameter :: FWrap_y_YawErr = 7 ! FWrap%YawErr + integer(IntKi), public, parameter :: FWrap_y_psi_skew = 8 ! FWrap%psi_skew + integer(IntKi), public, parameter :: FWrap_y_chi_skew = 9 ! FWrap%chi_skew + integer(IntKi), public, parameter :: FWrap_y_p_hub = 10 ! FWrap%p_hub + integer(IntKi), public, parameter :: FWrap_y_D_rotor = 11 ! FWrap%D_rotor + integer(IntKi), public, parameter :: FWrap_y_DiskAvg_Vx_Rel = 12 ! FWrap%DiskAvg_Vx_Rel + integer(IntKi), public, parameter :: FWrap_y_AzimAvg_Ct = 13 ! FWrap%AzimAvg_Ct + integer(IntKi), public, parameter :: FWrap_y_AzimAvg_Cq = 14 ! FWrap%AzimAvg_Cq + +contains subroutine FWrap_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(FWrap_InitInputType), intent(in) :: SrcInitInputData @@ -967,5 +982,337 @@ subroutine FWrap_UnPackOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%AzimAvg_Ct); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%AzimAvg_Cq); if (RegCheckErr(RF, RoutineName)) return end subroutine + +function FWrap_InputMeshPointer(u, DL) result(Mesh) + type(FWrap_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +function FWrap_OutputMeshPointer(y, DL) result(Mesh) + type(FWrap_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +subroutine FWrap_VarsPackContState(Vars, x, ValAry) + type(FWrap_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call FWrap_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine FWrap_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(FWrap_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FWrap_x_dummy) + VarVals(1) = x%dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FWrap_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FWrap_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call FWrap_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine FWrap_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FWrap_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FWrap_x_dummy) + x%dummy = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function FWrap_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FWrap_x_dummy) + Name = "x%dummy" + case default + Name = "Unknown Field" + end select +end function + +subroutine FWrap_VarsPackContStateDeriv(Vars, x, ValAry) + type(FWrap_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call FWrap_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine FWrap_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(FWrap_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FWrap_x_dummy) + VarVals(1) = x%dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FWrap_VarsPackConstrState(Vars, z, ValAry) + type(FWrap_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call FWrap_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine FWrap_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(FWrap_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FWrap_z_dummy) + VarVals(1) = z%dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FWrap_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FWrap_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call FWrap_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine FWrap_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FWrap_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FWrap_z_dummy) + z%dummy = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function FWrap_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FWrap_z_dummy) + Name = "z%dummy" + case default + Name = "Unknown Field" + end select +end function + +subroutine FWrap_VarsPackInput(Vars, u, ValAry) + type(FWrap_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call FWrap_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine FWrap_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(FWrap_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FWrap_u_fromSCglob) + VarVals = u%fromSCglob(V%iLB:V%iUB) ! Rank 1 Array + case (FWrap_u_fromSC) + VarVals = u%fromSC(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FWrap_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FWrap_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call FWrap_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine FWrap_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FWrap_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FWrap_u_fromSCglob) + u%fromSCglob(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (FWrap_u_fromSC) + u%fromSC(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function FWrap_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FWrap_u_fromSCglob) + Name = "u%fromSCglob" + case (FWrap_u_fromSC) + Name = "u%fromSC" + case default + Name = "Unknown Field" + end select +end function + +subroutine FWrap_VarsPackOutput(Vars, y, ValAry) + type(FWrap_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call FWrap_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine FWrap_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(FWrap_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FWrap_y_toSC) + VarVals = y%toSC(V%iLB:V%iUB) ! Rank 1 Array + case (FWrap_y_xHat_Disk) + VarVals = y%xHat_Disk(V%iLB:V%iUB) ! Rank 1 Array + case (FWrap_y_YawErr) + VarVals(1) = y%YawErr ! Scalar + case (FWrap_y_psi_skew) + VarVals(1) = y%psi_skew ! Scalar + case (FWrap_y_chi_skew) + VarVals(1) = y%chi_skew ! Scalar + case (FWrap_y_p_hub) + VarVals = y%p_hub(V%iLB:V%iUB) ! Rank 1 Array + case (FWrap_y_D_rotor) + VarVals(1) = y%D_rotor ! Scalar + case (FWrap_y_DiskAvg_Vx_Rel) + VarVals(1) = y%DiskAvg_Vx_Rel ! Scalar + case (FWrap_y_AzimAvg_Ct) + VarVals = y%AzimAvg_Ct(V%iLB:V%iUB) ! Rank 1 Array + case (FWrap_y_AzimAvg_Cq) + VarVals = y%AzimAvg_Cq(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FWrap_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FWrap_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call FWrap_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine FWrap_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FWrap_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FWrap_y_toSC) + y%toSC(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (FWrap_y_xHat_Disk) + y%xHat_Disk(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (FWrap_y_YawErr) + y%YawErr = VarVals(1) ! Scalar + case (FWrap_y_psi_skew) + y%psi_skew = VarVals(1) ! Scalar + case (FWrap_y_chi_skew) + y%chi_skew = VarVals(1) ! Scalar + case (FWrap_y_p_hub) + y%p_hub(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (FWrap_y_D_rotor) + y%D_rotor = VarVals(1) ! Scalar + case (FWrap_y_DiskAvg_Vx_Rel) + y%DiskAvg_Vx_Rel = VarVals(1) ! Scalar + case (FWrap_y_AzimAvg_Ct) + y%AzimAvg_Ct(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (FWrap_y_AzimAvg_Cq) + y%AzimAvg_Cq(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function FWrap_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FWrap_y_toSC) + Name = "y%toSC" + case (FWrap_y_xHat_Disk) + Name = "y%xHat_Disk" + case (FWrap_y_YawErr) + Name = "y%YawErr" + case (FWrap_y_psi_skew) + Name = "y%psi_skew" + case (FWrap_y_chi_skew) + Name = "y%chi_skew" + case (FWrap_y_p_hub) + Name = "y%p_hub" + case (FWrap_y_D_rotor) + Name = "y%D_rotor" + case (FWrap_y_DiskAvg_Vx_Rel) + Name = "y%DiskAvg_Vx_Rel" + case (FWrap_y_AzimAvg_Ct) + Name = "y%AzimAvg_Ct" + case (FWrap_y_AzimAvg_Cq) + Name = "y%AzimAvg_Cq" + case default + Name = "Unknown Field" + end select +end function + END MODULE FASTWrapper_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 b/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 index 0a7f1a60b0..6328690493 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 @@ -39,6 +39,8 @@ MODULE FAST_Farm_Subs #endif IMPLICIT NONE + + integer(IntKi), private, parameter :: iED = 1 CONTAINS @@ -890,7 +892,7 @@ SUBROUTINE Farm_InitMD( farm, ErrStat, ErrMsg ) IF (farm%FWrap(nt)%m%Turbine%p_FAST%CompSub == Module_SD) then SubstructureMotion => farm%FWrap(nt)%m%Turbine%SD%y%y3Mesh ELSE - SubstructureMotion => farm%FWrap(nt)%m%Turbine%ED%y%PlatformPtMesh + SubstructureMotion => farm%FWrap(nt)%m%Turbine%ED%y(iED)%PlatformPtMesh END IF CALL MeshMapCreate( SubstructureMotion, farm%MD%Input(1)%CoupledKinematics(nt), farm%m%FWrap_2_MD(nt), ErrStat2, ErrMsg2 ) @@ -974,7 +976,7 @@ subroutine FARM_MD_Increment(t, n, farm, ErrStat, ErrMsg) IF (farm%FWrap(nt)%m%Turbine%p_FAST%CompSub == Module_SD) then SubstructureMotion => farm%FWrap(nt)%m%Turbine%SD%y%y3Mesh ELSE - SubstructureMotion => farm%FWrap(nt)%m%Turbine%ED%y%PlatformPtMesh + SubstructureMotion => farm%FWrap(nt)%m%Turbine%ED%y(iED)%PlatformPtMesh END IF CALL Transfer_Point_to_Point( SubstructureMotion, farm%MD%Input(1)%CoupledKinematics(nt), farm%m%FWrap_2_MD(nt), ErrStat2, ErrMsg2 ) @@ -1004,7 +1006,7 @@ subroutine FARM_MD_Increment(t, n, farm, ErrStat, ErrMsg) IF (farm%FWrap(nt)%m%Turbine%p_FAST%CompSub == Module_SD) then SubstructureMotion => farm%FWrap(nt)%m%Turbine%SD%y%y3Mesh ELSE - SubstructureMotion => farm%FWrap(nt)%m%Turbine%ED%y%PlatformPtMesh + SubstructureMotion => farm%FWrap(nt)%m%Turbine%ED%y(iED)%PlatformPtMesh END IF ! mapping; Note: SubstructureLoads_Tmp_Farm contains loads from the farm-level (at a previous step); gets integrated into individual turbines inside FWrap_Increment() diff --git a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 index f2a0fce0e7..d5aec7ea2c 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 @@ -37,16 +37,16 @@ MODULE FAST_Farm_Types USE SuperController_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: NumFFModules = 5 ! The number of modules available in FAST.Farm [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_None = 0 ! No module selected [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_SC = 1 ! Super Controller [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_FWrap = 2 ! FAST Wrapper [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_WD = 3 ! Wake Dynamics [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_AWAE = 4 ! Ambient Wind and Array Effects [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_MD = 5 ! Farm-level MoorDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_WAT_None = 0 ! WAT: off [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_WAT_PreDef = 1 ! WAT: predefined turbulence boxes [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_WAT_UserDef = 2 ! WAT: user defined turbulence boxes [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: NumFFModules = 5 ! The number of modules available in FAST.Farm [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_None = 0 ! No module selected [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_SC = 1 ! Super Controller [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_FWrap = 2 ! FAST Wrapper [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_WD = 3 ! Wake Dynamics [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_AWAE = 4 ! Ambient Wind and Array Effects [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_MD = 5 ! Farm-level MoorDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_WAT_None = 0 ! WAT: off [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_WAT_PreDef = 1 ! WAT: predefined turbulence boxes [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_WAT_UserDef = 2 ! WAT: user defined turbulence boxes [-] ! ========= Farm_ParameterType ======= TYPE, PUBLIC :: Farm_ParameterType REAL(DbKi) :: DT_low = 0.0_R8Ki !< Time step for low-resolution wind data input files; will be used as the global FAST.Farm time step [seconds] @@ -216,7 +216,8 @@ MODULE FAST_Farm_Types TYPE(WAT_IfW_data) :: WAT_IfW !< IfW data for WAT (temporary location until pointers are enabled) [-] END TYPE All_FastFarm_Data ! ======================= -CONTAINS + +contains subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) type(Farm_ParameterType), intent(in) :: SrcParamData @@ -1661,5 +1662,7 @@ subroutine Farm_UnPackAll_FastFarm_Data(RF, OutData) call Farm_UnpackMD_Data(RF, OutData%MD) ! MD call Farm_UnpackWAT_IfW_data(RF, OutData%WAT_IfW) ! WAT_IfW end subroutine + END MODULE FAST_Farm_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/glue-codes/openfast/src/FAST_Prog.f90 b/glue-codes/openfast/src/FAST_Prog.f90 index f4e9b2bfe2..d41dd0e376 100644 --- a/glue-codes/openfast/src/FAST_Prog.f90 +++ b/glue-codes/openfast/src/FAST_Prog.f90 @@ -32,7 +32,7 @@ PROGRAM FAST USE FAST_Subs ! all of the ModuleName and ModuleName_types modules are inherited from FAST_Subs -USE FAST_SS_Subs, ONLY : FAST_RunSteadyStateDriver +USE FAST_AeroMap, ONLY : FAST_RunSteadyStateDriver IMPLICIT NONE @@ -81,6 +81,7 @@ PROGRAM FAST ! this runs the steady-state solver driver and ENDS the program: CALL FAST_RunSteadyStateDriver( Turbine(1) ) + CALL ExitThisProgram_T( Turbine(1), ErrID_None, .true., SkipRunTimeMsg = .TRUE. ) ELSEIF ( LEN( TRIM(FlagArg) ) > 0 ) THEN ! Any other flag, end normally CALL NormStop() @@ -131,7 +132,7 @@ PROGRAM FAST ! write checkpoint file if requested - 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 + IF (mod(n_t_global, Turbine(1)%p_FAST%n_ChkptTime) == 0 .AND. Restart_step /= n_t_global .and. .not. Turbine(1)%m_Glue%CS%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) @@ -155,13 +156,13 @@ 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 + IF ( Turbine(i_turb)%m_Glue%CS%FoundSteady) EXIT TIME_STEP_LOOP END DO 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 + if ( Turbine(i_turb)%p_FAST%CalcSteady .and. .not. Turbine(i_turb)%m_Glue%CS%FoundSteady) then CALL CheckError( ErrID_Fatal, "Unable to find steady-state solution." ) end if END DO diff --git a/glue-codes/simulink/CMakeLists.txt b/glue-codes/simulink/CMakeLists.txt index c927e8c0e2..1a0cbbc25c 100644 --- a/glue-codes/simulink/CMakeLists.txt +++ b/glue-codes/simulink/CMakeLists.txt @@ -56,10 +56,13 @@ matlab_add_mex( SRC src/FAST_SFunc.c ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Subs.f90 - ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Lin.f90 ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Mods.f90 - ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Solver.f90 + ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_SolverTC.f90 ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Library.f90 + ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Funcs.f90 + ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_ModGlue.f90 + ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_AeroMap.f90 + ${PROJECT_SOURCE_DIR}/modules/openfast-library/src/FAST_Mapping.f90 LINK_TO ${MEX_LIBS} ${MEX_LIBS} # DO NOT REMOVE (needed to ensure no unresolved symbols) diff --git a/modules/aerodisk/src/AeroDisk.f90 b/modules/aerodisk/src/AeroDisk.f90 index e6257ac2d7..da72cbc5a5 100644 --- a/modules/aerodisk/src/AeroDisk.f90 +++ b/modules/aerodisk/src/AeroDisk.f90 @@ -144,6 +144,10 @@ SUBROUTINE ADsk_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO ! Set some other stuff that the framework requires call Init_OtherStuff(ErrStat2,ErrMsg2); if (Failed()) return + ! Initialize module variables + call ADsk_InitVars(u, p, x, y, m, InitOut%Vars, InputFileData, .false., ErrStat2, ErrMsg2) + if (Failed()) return + contains logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -266,6 +270,64 @@ subroutine Init_InitY(ErrStat3,ErrMsg3) end subroutine Init_InitY END SUBROUTINE ADsk_Init +subroutine ADsk_InitVars(u, p, x, y, m, Vars, InputFileData, Linearize, ErrStat, ErrMsg) + type(ADsk_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(ADsk_ParameterType), intent(inout) :: p !< Parameters + type(ADsk_ContinuousStateType), intent(inout) :: x !< Continuous state + type(ADsk_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(ADsk_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(ModVarsType), intent(inout) :: Vars !< Module variables + type(ADsk_InputFile), intent(in) :: InputFileData !< Input file data + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_No ne + + character(*), parameter :: RoutineName = 'ADsk_InitVars' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + real(R8Ki) :: MaxThrust, MaxTorque, ScaleLength + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = "" + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + call MV_AddMeshVar(Vars%u, "Hub", MotionFields, & + DL=DatLoc(ADsk_u_HubMotion), & + Mesh=u%HubMotion) + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + call MV_AddMeshVar(Vars%y, 'AeroLoads', LoadFields, & + DatLoc(ADsk_y_AeroLoads), & + Mesh=y%AeroLoads) + + !---------------------------------------------------------------------------- + ! Initialization dependent on linearization + !---------------------------------------------------------------------------- + + call MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + call ADsk_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ADsk_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ADsk_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ADsk_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the end of the simulation. diff --git a/modules/aerodisk/src/AeroDisk_Registry.txt b/modules/aerodisk/src/AeroDisk_Registry.txt index e3247e633b..990dfbaafd 100644 --- a/modules/aerodisk/src/AeroDisk_Registry.txt +++ b/modules/aerodisk/src/AeroDisk_Registry.txt @@ -66,7 +66,7 @@ typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - typedef ^ InitOutputType ReKi AirDens - - - "Air density" "kg/m^3" - +typedef ^ InitOutputType ModVarsType Vars - - - "Module variables" - # ..... Inputs .................................................................................................................... # inputs on meshes: NONE @@ -136,4 +136,10 @@ typedef ^ MiscVarType SiKi Moment 3 - typedef ^ MiscVarType ReKi DiskWindPosAbs {:}{:} - - "Disk locations for sampling to get disk avarage velocity (absolute for getting wind)" m typedef ^ MiscVarType ReKi DiskWindVel {:}{:} - - "Wind speed at disk locations for disk velocity" m/s typedef ^ MiscVarType ReKi DiskAvgVel 3 - - "Average wind speed across rotor disk" m/s +typedef ^ MiscVarType ModJacType Jac - - - "Values corresponding to module variables" +typedef ^ MiscVarType ADsk_ContinuousStateType x_perturb - - - "Continuous state type for linearization perturbation" - +typedef ^ MiscVarType ADsk_ContinuousStateType dxdt_lin - - - "Continuous state type for linearization output" - +typedef ^ MiscVarType ADsk_InputType u_perturb - - - "Input type for linearization perturbation" - +typedef ^ MiscVarType ADsk_OutputType y_lin - - - "Output type for linearization output" - + diff --git a/modules/aerodisk/src/AeroDisk_Types.f90 b/modules/aerodisk/src/AeroDisk_Types.f90 index 61fef67b28..ee7a113336 100644 --- a/modules/aerodisk/src/AeroDisk_Types.f90 +++ b/modules/aerodisk/src/AeroDisk_Types.f90 @@ -34,7 +34,7 @@ MODULE AeroDisk_Types USE IfW_FlowField_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: ADsk_NumPtsDiskAvg = 144 ! Number of points averaged for rotor-average wind speed [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ADsk_NumPtsDiskAvg = 144 ! Number of points averaged for rotor-average wind speed [-] ! ========= ADsk_AeroTable ======= TYPE, PUBLIC :: ADsk_AeroTable INTEGER(IntKi) :: N_TSR = 0_IntKi !< Number of rotor tip-speed ratios in tables [-] @@ -87,6 +87,7 @@ MODULE AeroDisk_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] + TYPE(ModVarsType) :: Vars !< Module variables [-] END TYPE ADsk_InitOutputType ! ======================= ! ========= ADsk_InputType ======= @@ -161,9 +162,28 @@ MODULE AeroDisk_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DiskWindPosAbs !< Disk locations for sampling to get disk avarage velocity (absolute for getting wind) [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DiskWindVel !< Wind speed at disk locations for disk velocity [m/s] REAL(ReKi) , DIMENSION(1:3) :: DiskAvgVel = 0.0_ReKi !< Average wind speed across rotor disk [m/s] + TYPE(ModJacType) :: Jac !< Values corresponding to module variables [-] + TYPE(ADsk_ContinuousStateType) :: x_perturb !< Continuous state type for linearization perturbation [-] + TYPE(ADsk_ContinuousStateType) :: dxdt_lin !< Continuous state type for linearization output [-] + TYPE(ADsk_InputType) :: u_perturb !< Input type for linearization perturbation [-] + TYPE(ADsk_OutputType) :: y_lin !< Output type for linearization output [-] END TYPE ADsk_MiscVarType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: ADsk_x_DummyContState = 1 ! ADsk%DummyContState + integer(IntKi), public, parameter :: ADsk_z_DummyConstrState = 2 ! ADsk%DummyConstrState + integer(IntKi), public, parameter :: ADsk_u_HubMotion = 3 ! ADsk%HubMotion + integer(IntKi), public, parameter :: ADsk_u_RotSpeed = 4 ! ADsk%RotSpeed + integer(IntKi), public, parameter :: ADsk_u_BlPitch = 5 ! ADsk%BlPitch + integer(IntKi), public, parameter :: ADsk_y_AeroLoads = 6 ! ADsk%AeroLoads + integer(IntKi), public, parameter :: ADsk_y_YawErr = 7 ! ADsk%YawErr + integer(IntKi), public, parameter :: ADsk_y_PsiSkew = 8 ! ADsk%PsiSkew + integer(IntKi), public, parameter :: ADsk_y_ChiSkew = 9 ! ADsk%ChiSkew + integer(IntKi), public, parameter :: ADsk_y_VRel = 10 ! ADsk%VRel + integer(IntKi), public, parameter :: ADsk_y_Ct = 11 ! ADsk%Ct + integer(IntKi), public, parameter :: ADsk_y_Cq = 12 ! ADsk%Cq + integer(IntKi), public, parameter :: ADsk_y_WriteOutput = 13 ! ADsk%WriteOutput + +contains subroutine ADsk_CopyAeroTable(SrcAeroTableData, DstAeroTableData, CtrlCode, ErrStat, ErrMsg) type(ADsk_AeroTable), intent(in) :: SrcAeroTableData @@ -636,6 +656,9 @@ subroutine ADsk_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstInitOutputData%AirDens = SrcInitOutputData%AirDens + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine ADsk_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -655,6 +678,8 @@ subroutine ADsk_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ADsk_PackInitOutput(RF, Indata) @@ -666,6 +691,7 @@ subroutine ADsk_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%WriteOutputUnt) call NWTC_Library_PackProgDesc(RF, InData%Ver) call RegPack(RF, InData%AirDens) + call NWTC_Library_PackModVarsType(RF, InData%Vars) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -681,6 +707,7 @@ subroutine ADsk_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end subroutine subroutine ADsk_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -1144,13 +1171,14 @@ subroutine ADsk_UnPackParam(RF, OutData) end subroutine subroutine ADsk_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(ADsk_MiscVarType), intent(in) :: SrcMiscData + type(ADsk_MiscVarType), intent(inout) :: SrcMiscData type(ADsk_MiscVarType), intent(inout) :: DstMiscData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADsk_CopyMisc' ErrStat = ErrID_None ErrMsg = '' @@ -1203,12 +1231,29 @@ subroutine ADsk_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%DiskWindVel = SrcMiscData%DiskWindVel end if DstMiscData%DiskAvgVel = SrcMiscData%DiskAvgVel + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADsk_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADsk_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADsk_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADsk_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine ADsk_DestroyMisc(MiscData, ErrStat, ErrMsg) type(ADsk_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADsk_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' @@ -1221,6 +1266,16 @@ subroutine ADsk_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%DiskWindVel)) then deallocate(MiscData%DiskWindVel) end if + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADsk_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADsk_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADsk_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADsk_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ADsk_PackMisc(RF, Indata) @@ -1244,6 +1299,11 @@ subroutine ADsk_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%DiskWindPosAbs) call RegPackAlloc(RF, InData%DiskWindVel) call RegPack(RF, InData%DiskAvgVel) + call NWTC_Library_PackModJacType(RF, InData%Jac) + call ADsk_PackContState(RF, InData%x_perturb) + call ADsk_PackContState(RF, InData%dxdt_lin) + call ADsk_PackInput(RF, InData%u_perturb) + call ADsk_PackOutput(RF, InData%y_lin) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1271,6 +1331,11 @@ subroutine ADsk_UnPackMisc(RF, OutData) call RegUnpackAlloc(RF, OutData%DiskWindPosAbs); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%DiskWindVel); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DiskAvgVel); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call ADsk_UnpackContState(RF, OutData%x_perturb) ! x_perturb + call ADsk_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin + call ADsk_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call ADsk_UnpackOutput(RF, OutData%y_lin) ! y_lin end subroutine subroutine ADsk_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) @@ -1610,5 +1675,335 @@ SUBROUTINE ADsk_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function ADsk_InputMeshPointer(u, DL) result(Mesh) + type(ADsk_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (ADsk_u_HubMotion) + Mesh => u%HubMotion + end select +end function + +function ADsk_OutputMeshPointer(y, DL) result(Mesh) + type(ADsk_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (ADsk_y_AeroLoads) + Mesh => y%AeroLoads + end select +end function + +subroutine ADsk_VarsPackContState(Vars, x, ValAry) + type(ADsk_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call ADsk_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine ADsk_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(ADsk_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADsk_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADsk_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ADsk_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call ADsk_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine ADsk_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ADsk_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADsk_x_DummyContState) + x%DummyContState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function ADsk_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ADsk_x_DummyContState) + Name = "x%DummyContState" + case default + Name = "Unknown Field" + end select +end function + +subroutine ADsk_VarsPackContStateDeriv(Vars, x, ValAry) + type(ADsk_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call ADsk_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine ADsk_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(ADsk_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADsk_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADsk_VarsPackConstrState(Vars, z, ValAry) + type(ADsk_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call ADsk_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine ADsk_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(ADsk_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADsk_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADsk_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ADsk_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call ADsk_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine ADsk_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ADsk_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADsk_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function ADsk_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ADsk_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine ADsk_VarsPackInput(Vars, u, ValAry) + type(ADsk_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call ADsk_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine ADsk_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(ADsk_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADsk_u_HubMotion) + call MV_PackMesh(V, u%HubMotion, ValAry) ! Mesh + case (ADsk_u_RotSpeed) + VarVals(1) = u%RotSpeed ! Scalar + case (ADsk_u_BlPitch) + VarVals(1) = u%BlPitch ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADsk_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ADsk_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call ADsk_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine ADsk_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ADsk_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADsk_u_HubMotion) + call MV_UnpackMesh(V, ValAry, u%HubMotion) ! Mesh + case (ADsk_u_RotSpeed) + u%RotSpeed = VarVals(1) ! Scalar + case (ADsk_u_BlPitch) + u%BlPitch = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function ADsk_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ADsk_u_HubMotion) + Name = "u%HubMotion" + case (ADsk_u_RotSpeed) + Name = "u%RotSpeed" + case (ADsk_u_BlPitch) + Name = "u%BlPitch" + case default + Name = "Unknown Field" + end select +end function + +subroutine ADsk_VarsPackOutput(Vars, y, ValAry) + type(ADsk_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call ADsk_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine ADsk_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(ADsk_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADsk_y_AeroLoads) + call MV_PackMesh(V, y%AeroLoads, ValAry) ! Mesh + case (ADsk_y_YawErr) + VarVals(1) = y%YawErr ! Scalar + case (ADsk_y_PsiSkew) + VarVals(1) = y%PsiSkew ! Scalar + case (ADsk_y_ChiSkew) + VarVals(1) = y%ChiSkew ! Scalar + case (ADsk_y_VRel) + VarVals(1) = y%VRel ! Scalar + case (ADsk_y_Ct) + VarVals(1) = y%Ct ! Scalar + case (ADsk_y_Cq) + VarVals(1) = y%Cq ! Scalar + case (ADsk_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADsk_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ADsk_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call ADsk_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine ADsk_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ADsk_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADsk_y_AeroLoads) + call MV_UnpackMesh(V, ValAry, y%AeroLoads) ! Mesh + case (ADsk_y_YawErr) + y%YawErr = VarVals(1) ! Scalar + case (ADsk_y_PsiSkew) + y%PsiSkew = VarVals(1) ! Scalar + case (ADsk_y_ChiSkew) + y%ChiSkew = VarVals(1) ! Scalar + case (ADsk_y_VRel) + y%VRel = VarVals(1) ! Scalar + case (ADsk_y_Ct) + y%Ct = VarVals(1) ! Scalar + case (ADsk_y_Cq) + y%Cq = VarVals(1) ! Scalar + case (ADsk_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function ADsk_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ADsk_y_AeroLoads) + Name = "y%AeroLoads" + case (ADsk_y_YawErr) + Name = "y%YawErr" + case (ADsk_y_PsiSkew) + Name = "y%PsiSkew" + case (ADsk_y_ChiSkew) + Name = "y%ChiSkew" + case (ADsk_y_VRel) + Name = "y%VRel" + case (ADsk_y_Ct) + Name = "y%Ct" + case (ADsk_y_Cq) + Name = "y%Cq" + case (ADsk_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE AeroDisk_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/CMakeLists.txt b/modules/aerodyn/CMakeLists.txt index 3ace5a80d3..74b76b9388 100644 --- a/modules/aerodyn/CMakeLists.txt +++ b/modules/aerodyn/CMakeLists.txt @@ -68,7 +68,7 @@ add_library(aerodynlib STATIC src/FVW_Tests.f90 src/FVW_Types.f90 ) -target_link_libraries(aerodynlib basicaerolib nwtclibs) +target_link_libraries(aerodynlib basicaerolib nwtclibs seastlib) # ADI lib add_library(adilib STATIC diff --git a/modules/aerodyn/python-lib/aerodyn_inflow_library.py b/modules/aerodyn/python-lib/aerodyn_inflow_library.py index a0cae3d526..c8f91ecbab 100644 --- a/modules/aerodyn/python-lib/aerodyn_inflow_library.py +++ b/modules/aerodyn/python-lib/aerodyn_inflow_library.py @@ -3,6 +3,7 @@ # Copyright (C) 2021 National Renewable Energy Laboratory # # This file is part of AeroDyn. +# This file is part of AeroDyn. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index 19b850b12c..fe8bb54fcf 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -272,7 +272,26 @@ MODULE AeroAcoustics_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutputNode !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] END TYPE AA_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: AA_x_DummyContState = 1 ! AA%DummyContState + integer(IntKi), public, parameter :: AA_z_DummyConstrState = 2 ! AA%DummyConstrState + integer(IntKi), public, parameter :: AA_u_RotGtoL = 3 ! AA%RotGtoL + integer(IntKi), public, parameter :: AA_u_AeroCent_G = 4 ! AA%AeroCent_G + integer(IntKi), public, parameter :: AA_u_Vrel = 5 ! AA%Vrel + integer(IntKi), public, parameter :: AA_u_AoANoise = 6 ! AA%AoANoise + integer(IntKi), public, parameter :: AA_u_Inflow = 7 ! AA%Inflow + integer(IntKi), public, parameter :: AA_y_SumSpecNoise = 8 ! AA%SumSpecNoise + integer(IntKi), public, parameter :: AA_y_SumSpecNoiseSep = 9 ! AA%SumSpecNoiseSep + integer(IntKi), public, parameter :: AA_y_OASPL = 10 ! AA%OASPL + integer(IntKi), public, parameter :: AA_y_OASPL_Mech = 11 ! AA%OASPL_Mech + integer(IntKi), public, parameter :: AA_y_DirectiviOutput = 12 ! AA%DirectiviOutput + integer(IntKi), public, parameter :: AA_y_OutLECoords = 13 ! AA%OutLECoords + integer(IntKi), public, parameter :: AA_y_PtotalFreq = 14 ! AA%PtotalFreq + integer(IntKi), public, parameter :: AA_y_WriteOutputForPE = 15 ! AA%WriteOutputForPE + integer(IntKi), public, parameter :: AA_y_WriteOutput = 16 ! AA%WriteOutput + integer(IntKi), public, parameter :: AA_y_WriteOutputSep = 17 ! AA%WriteOutputSep + integer(IntKi), public, parameter :: AA_y_WriteOutputNode = 18 ! AA%WriteOutputNode + +contains subroutine AA_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, CtrlCode, ErrStat, ErrMsg) type(AA_BladePropsType), intent(in) :: SrcBladePropsTypeData @@ -2941,5 +2960,361 @@ subroutine AA_UnPackOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WriteOutputSep); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputNode); if (RegCheckErr(RF, RoutineName)) return end subroutine + +function AA_InputMeshPointer(u, DL) result(Mesh) + type(AA_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +function AA_OutputMeshPointer(y, DL) result(Mesh) + type(AA_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +subroutine AA_VarsPackContState(Vars, x, ValAry) + type(AA_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call AA_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine AA_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(AA_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AA_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AA_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AA_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call AA_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine AA_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(AA_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AA_x_DummyContState) + x%DummyContState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function AA_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AA_x_DummyContState) + Name = "x%DummyContState" + case default + Name = "Unknown Field" + end select +end function + +subroutine AA_VarsPackContStateDeriv(Vars, x, ValAry) + type(AA_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call AA_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine AA_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(AA_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AA_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AA_VarsPackConstrState(Vars, z, ValAry) + type(AA_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call AA_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine AA_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(AA_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AA_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AA_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AA_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call AA_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine AA_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(AA_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AA_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function AA_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AA_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine AA_VarsPackInput(Vars, u, ValAry) + type(AA_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call AA_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine AA_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(AA_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AA_u_RotGtoL) + VarVals = u%RotGtoL(V%iLB:V%iUB, V%j, V%k, V%m) ! Rank 4 Array + case (AA_u_AeroCent_G) + VarVals = u%AeroCent_G(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (AA_u_Vrel) + VarVals = u%Vrel(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (AA_u_AoANoise) + VarVals = u%AoANoise(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (AA_u_Inflow) + VarVals = u%Inflow(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AA_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AA_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call AA_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine AA_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(AA_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AA_u_RotGtoL) + u%RotGtoL(V%iLB:V%iUB, V%j, V%k, V%m) = VarVals ! Rank 4 Array + case (AA_u_AeroCent_G) + u%AeroCent_G(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (AA_u_Vrel) + u%Vrel(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (AA_u_AoANoise) + u%AoANoise(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (AA_u_Inflow) + u%Inflow(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + end select + end associate +end subroutine + +function AA_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AA_u_RotGtoL) + Name = "u%RotGtoL" + case (AA_u_AeroCent_G) + Name = "u%AeroCent_G" + case (AA_u_Vrel) + Name = "u%Vrel" + case (AA_u_AoANoise) + Name = "u%AoANoise" + case (AA_u_Inflow) + Name = "u%Inflow" + case default + Name = "Unknown Field" + end select +end function + +subroutine AA_VarsPackOutput(Vars, y, ValAry) + type(AA_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call AA_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine AA_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(AA_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AA_y_SumSpecNoise) + VarVals = y%SumSpecNoise(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (AA_y_SumSpecNoiseSep) + VarVals = y%SumSpecNoiseSep(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (AA_y_OASPL) + VarVals = y%OASPL(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (AA_y_OASPL_Mech) + VarVals = y%OASPL_Mech(V%iLB:V%iUB, V%j, V%k, V%m) ! Rank 4 Array + case (AA_y_DirectiviOutput) + VarVals = y%DirectiviOutput(V%iLB:V%iUB) ! Rank 1 Array + case (AA_y_OutLECoords) + VarVals = y%OutLECoords(V%iLB:V%iUB, V%j, V%k, V%m) ! Rank 4 Array + case (AA_y_PtotalFreq) + VarVals = y%PtotalFreq(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (AA_y_WriteOutputForPE) + VarVals = y%WriteOutputForPE(V%iLB:V%iUB) ! Rank 1 Array + case (AA_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case (AA_y_WriteOutputSep) + VarVals = y%WriteOutputSep(V%iLB:V%iUB) ! Rank 1 Array + case (AA_y_WriteOutputNode) + VarVals = y%WriteOutputNode(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AA_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AA_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call AA_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine AA_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(AA_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AA_y_SumSpecNoise) + y%SumSpecNoise(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (AA_y_SumSpecNoiseSep) + y%SumSpecNoiseSep(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (AA_y_OASPL) + y%OASPL(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (AA_y_OASPL_Mech) + y%OASPL_Mech(V%iLB:V%iUB, V%j, V%k, V%m) = VarVals ! Rank 4 Array + case (AA_y_DirectiviOutput) + y%DirectiviOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (AA_y_OutLECoords) + y%OutLECoords(V%iLB:V%iUB, V%j, V%k, V%m) = VarVals ! Rank 4 Array + case (AA_y_PtotalFreq) + y%PtotalFreq(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (AA_y_WriteOutputForPE) + y%WriteOutputForPE(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (AA_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (AA_y_WriteOutputSep) + y%WriteOutputSep(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (AA_y_WriteOutputNode) + y%WriteOutputNode(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function AA_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AA_y_SumSpecNoise) + Name = "y%SumSpecNoise" + case (AA_y_SumSpecNoiseSep) + Name = "y%SumSpecNoiseSep" + case (AA_y_OASPL) + Name = "y%OASPL" + case (AA_y_OASPL_Mech) + Name = "y%OASPL_Mech" + case (AA_y_DirectiviOutput) + Name = "y%DirectiviOutput" + case (AA_y_OutLECoords) + Name = "y%OutLECoords" + case (AA_y_PtotalFreq) + Name = "y%PtotalFreq" + case (AA_y_WriteOutputForPE) + Name = "y%WriteOutputForPE" + case (AA_y_WriteOutput) + Name = "y%WriteOutput" + case (AA_y_WriteOutputSep) + Name = "y%WriteOutputSep" + case (AA_y_WriteOutputNode) + Name = "y%WriteOutputNode" + case default + Name = "Unknown Field" + end select +end function + END MODULE AeroAcoustics_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 6ed9b86c50..79c61afa91 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -31,7 +31,9 @@ module AeroDyn use UnsteadyAero use FVW use FVW_Subs, only: FVW_AeroOuts - use IfW_FlowField, only: IfW_FlowField_GetVelAcc, IfW_UniformWind_GetOP, IfW_UniformWind_Perturb, IfW_FlowField_CopyFlowFieldType + use IfW_FlowField_Types + use IfW_FlowField, only: IfW_FlowField_GetVelAcc, IfW_FlowField_CopyFlowFieldType + use SeaSt_WaveField, only: WaveField_GetWaveVelAcc_AD implicit none private @@ -46,7 +48,7 @@ module AeroDyn ! continuous states, and updating discrete states public :: AD_CalcOutput ! Routine for computing outputs public :: AD_CalcConstrStateResidual ! Tight coupling routine for returning the constraint state residual - + public :: RotCalcContStateDeriv PUBLIC :: AD_JacobianPInput ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - ! (Xd), and constraint - state(Z) functions all with respect to the inputs(u) @@ -59,7 +61,8 @@ module AeroDyn PUBLIC :: AD_JacobianPConstrState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - ! (Xd), and constraint - state(Z) functions all with respect to the constraint ! states(z) - PUBLIC :: AD_GetOP !< Routine to pack the operating point values (for linearization) into arrays + PUBLIC :: AD_VarsPackExtInput !< Routine pack extended inputs + public :: AD_CalcWind_Rotor !< Routine to calculate rotor wind inputs contains !---------------------------------------------------------------------------------------------------------------------------------- @@ -420,12 +423,22 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! Calculate buoyancy parameters !............................................................................................ do iR = 1, nRotors - if ( p%rotors(iR)%Buoyancy ) then + if ( p%rotors(iR)%MHK > 0 ) then call SetBuoyancyParameters( InputFileData%rotors(iR), u%rotors(iR), p%rotors(iR), ErrStat2, ErrMsg2 ) if (Failed()) return; end if end do + !............................................................................................ + ! Calculate inertia and added mass parameters + !............................................................................................ + do iR = 1, nRotors + if ( p%rotors(iR)%MHK > 0 ) then + call SetAddedMassInertiaParameters( InputFileData%rotors(iR), p%rotors(iR), ErrStat2, ErrMsg2 ) + if (Failed()) return; + end if + end do + !............................................................................................ ! Initialize the BEMT module (also sets other variables for sub module) !............................................................................................ @@ -544,14 +557,14 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut enddo !............................................................................................ - ! Initialize Jacobian: + ! Module Variables !............................................................................................ - if (InitInp%Linearize .or. InitInp%CompAeroMaps) then - do iR = 1, nRotors - call Init_Jacobian(InputFileData%rotors(iR), p%rotors(iR), p, u%rotors(iR), y%rotors(iR), m%rotors(iR), InitOut%rotors(iR), errStat2, errMsg2) - if (Failed()) return; - enddo - end if + + do iR = 1, nRotors + call AD_InitVars(iR, u%rotors(iR), p%rotors(iR), x%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), InitOut%rotors(iR), & + InputFileData%rotors(iR), InitInp%Linearize, InitInp%CompAeroMaps, ErrStat2, ErrMsg2) + if (Failed()) return; + end do !............................................................................................ ! Print the summary file if requested: @@ -782,7 +795,7 @@ subroutine Init_MiscVars(m, p, p_AD, u, y, errStat, errMsg) if (ErrStat >= AbortErrLev) RETURN - if (p%Buoyancy) then + if (p%MHK > 0) then ! Point mesh for blade buoyant loads allocate(m%BladeBuoyLoadPoint(p%NumBlades), Stat = ErrStat2) if (ErrStat2 /= 0) then @@ -931,9 +944,22 @@ subroutine Init_MiscVars(m, p, p_AD, u, y, errStat, errMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':T_P_2_T_L') if (ErrStat >= AbortErrLev) RETURN + + call AllocAry( m%TwrFI, 3_IntKi, p%NumTwrNds, 'm%TwrFI', ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + call AllocAry( m%TwrFA, 3_IntKi, p%NumTwrNds, 'm%TwrFA', ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) end if + + call AllocAry( m%BlFI, 3_IntKi, p%NumBlNds, p%numBlades, 'm%BlFI', ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + call AllocAry( m%BlFA, 3_IntKi, p%NumBlNds, p%numBlades, 'm%BlFA', ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + call AllocAry( m%BlMA, 3_IntKi, p%NumBlNds, p%numBlades, 'm%BlMA', ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) end if ! @@ -998,7 +1024,7 @@ subroutine Init_y(y, u, p, errStat, errMsg) errMsg = "" - if (p%NumTwrNds > 0 .and. (p%TwrAero /= TwrAero_None .or. p%Buoyancy)) then + if (p%NumTwrNds > 0 .and. (p%TwrAero /= TwrAero_None .or. p%MHK > 0)) then call MeshCopy ( SrcMesh = u%TowerMotion & , DestMesh = y%TowerLoad & @@ -1293,6 +1319,7 @@ subroutine Init_u( u, p, p_AD, InputFileData, MHK, WtrDpth, InitInp, errStat, er u%BladeMotion(k)%TranslationVel = 0.0_ReKi u%BladeMotion(k)%RotationVel = 0.0_ReKi u%BladeMotion(k)%TranslationAcc = 0.0_ReKi + u%BladeMotion(k)%RotationAcc = 0.0_ReKi if (p_AD%CompAeroMaps) then do j=1,InputFileData%BladeProps(k)%NumBlNds @@ -1403,6 +1430,7 @@ subroutine SetParameters( InitInp, InputFileData, RotData, p, p_AD, ErrStat, Err p_AD%UA_Flag = InputFileData%UA_Init%UAMod > UA_None p_AD%CompAeroMaps = InitInp%CompAeroMaps + p_AD%CompSeaSt = InitInp%CompSeaSt p_AD%SectAvg = InputFileData%SectAvg p_AD%SA_Weighting = InputFileData%SA_Weighting @@ -1419,7 +1447,6 @@ subroutine SetParameters( InitInp, InputFileData, RotData, p, p_AD, ErrStat, Err p%TwrShadow = InputFileData%TwrShadow p%TwrAero = InputFileData%TwrAero p%CavitCheck = InputFileData%CavitCheck - p%Buoyancy = InputFileData%Buoyancy p%NacelleDrag = InputFileData%NacelleDrag p%NacArea = RotData%NacArea @@ -1436,24 +1463,26 @@ subroutine SetParameters( InitInp, InputFileData, RotData, p, p_AD, ErrStat, Err p%NumBlNds = 0 endif - if (p%NumBlades>0 .and. p%Buoyancy) then + if (p%NumBlades>0 .and. p%MHK > 0) then call AllocAry( p%BlCenBn, p%NumBlNds, p%NumBlades, 'BlCenBn', ErrStat2, ErrMsg2 ) call AllocAry( p%BlCenBt, p%NumBlNds, p%NumBlades, 'BlCenBt', ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) endif - if (RotData%NumTwrNds > 0 .and. (p%TwrPotent /= TwrPotent_none .or. p%TwrShadow /= TwrShadow_none .or. p%TwrAero /= TwrAero_none .or. p%Buoyancy)) then + if (RotData%NumTwrNds > 0 .and. (p%TwrPotent /= TwrPotent_none .or. p%TwrShadow /= TwrShadow_none .or. p%TwrAero /= TwrAero_none .or. p%MHK > 0)) then p%NumTwrNds = RotData%NumTwrNds call move_alloc( RotData%TwrDiam, p%TwrDiam ) - call move_alloc( RotData%TwrCd, p%TwrCd ) - call move_alloc( RotData%TwrTI, p%TwrTI ) - call move_alloc( RotData%TwrCb, p%TwrCb ) + call move_alloc( RotData%TwrCd , p%TwrCd ) + call move_alloc( RotData%TwrTI , p%TwrTI ) + call move_alloc( RotData%TwrCb , p%TwrCb ) + call move_alloc( RotData%TwrCp , p%TwrCp ) + call move_alloc( RotData%TwrCa , p%TwrCa ) else p%NumTwrNds = 0 end if - if (p%Buoyancy) then + if (p%MHK > 0) then do k = 1,p%NumBlades p%BlCenBn(:,k) = RotData%BladeProps(k)%BlCenBn p%BlCenBt(:,k) = RotData%BladeProps(k)%BlCenBt @@ -1607,6 +1636,72 @@ subroutine SetBuoyancyParameters( InputFileData, u, p, ErrStat, ErrMsg ) end subroutine SetBuoyancyParameters !---------------------------------------------------------------------------------------------------------------------------------- +!> This routine sets parameters for use during the inertia and added mass calculations; these variables are not changed after AD_Init. +subroutine SetAddedMassInertiaParameters( InputFileData, p, ErrStat, ErrMsg ) + TYPE(RotInputFile), INTENT(IN ) :: InputFileData !< All the data in the AeroDyn input file + TYPE(RotParameterType), 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) :: ErrStat2 !< Temporary error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 !< Temporary error message if ErrStat /= ErrID_None + INTEGER(IntKi) :: k !< Loop counter for blades + INTEGER(IntKi) :: j !< Loop counter for nodes + + CHARACTER(*), PARAMETER :: RoutineName = 'SetAddedMassInertiaParameters' + + + ! Initialize variables for this routine + ErrStat = ErrID_None + ErrMsg = "" + + + ! Allocate inertia and added mass parameters + call AllocAry( p%BlIN, p%NumBlNds, p%NumBlades, 'BlIN', ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call AllocAry( p%BlIT, p%NumBlNds, p%NumBlades, 'BlIT', ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call AllocAry( p%BlAN, p%NumBlNds, p%NumBlades, 'BlAN', ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call AllocAry( p%BlAT, p%NumBlNds, p%NumBlades, 'BlAT', ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call AllocAry( p%BlAM, p%NumBlNds, p%NumBlades, 'BlAM', ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + if ( p%NumTwrNds > 0 ) then + call AllocAry( p%TwrIT, p%NumTwrNds, 'TwrIT', ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call AllocAry( p%TwrAT, p%NumTwrNds, 'TwrAT', ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end if + + ! Calculate blade inertia and added mass parameters + do k = 1,p%NumBlades ! loop through all blades + + do j = 1,p%NumBlNds ! loop through all nodes + p%BlIN(j,k) = (InputFileData%BladeProps(k)%BlCpn(j) + InputFileData%BladeProps(k)%BlCan(j)) * p%airDens * InputFileData%BladeProps(k)%BlChord(j)**2 * InputFileData%BladeProps(k)%t_c(j) ! node j normal-to-chord inertia factor + p%BlIT(j,k) = (InputFileData%BladeProps(k)%BlCpt(j) + InputFileData%BladeProps(k)%BlCat(j)) * p%airDens * InputFileData%BladeProps(k)%BlChord(j)**2 * InputFileData%BladeProps(k)%t_c(j) ! node j tangential-to-chord inertia factor + p%BlAN(j,k) = -InputFileData%BladeProps(k)%BlCan(j) * p%airDens * InputFileData%BladeProps(k)%BlChord(j)**2 * InputFileData%BladeProps(k)%t_c(j) ! node j normal-to-chord added mass factor + p%BlAT(j,k) = -InputFileData%BladeProps(k)%BlCat(j) * p%airDens * InputFileData%BladeProps(k)%BlChord(j)**2 * InputFileData%BladeProps(k)%t_c(j) ! node j tangential-to-chord added mass factor + p%BlAM(j,k) = -InputFileData%BladeProps(k)%BlCam(j) * p%airDens * InputFileData%BladeProps(k)%BlChord(j)**2 * InputFileData%BladeProps(k)%t_c(j) * (InputFileData%BladeProps(k)%BlChord(j)**2 + InputFileData%BladeProps(k)%BlChord(j)**2 * InputFileData%BladeProps(k)%t_c(j)**2) ! node j pitch added mass factor + end do ! j = nodes + + end do ! k = blades + + ! Calculate tower inertia and added mass parameters + if ( p%NumTwrNds > 0 ) then + + do j = 1,p%NumTwrNds ! loop through all nodes + p%TwrIT(j) = (p%TwrCp(j) + p%TwrCa(j)) * p%airDens * pi * (p%TwrDiam(j)/2.0_ReKi)**2 ! node j tangential inertia factor + p%TwrAT(j) = -p%TwrCa(j) * p%airDens * pi * (p%TwrDiam(j)/2.0_ReKi)**2 ! node j tangential added mass factor + end do ! j = nodes + + end if + +end subroutine SetAddedMassInertiaParameters +!---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the end of the simulation. subroutine AD_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) !.................................................................................................................................. @@ -1715,7 +1810,7 @@ subroutine AD_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, errStat ! Set wind -- NOTE: this is inneficient since the previous input value resides at m%Inflow(2) do i=1,size(u) - call AD_CalcWind(utimes(i), u(i), p%FLowField, p, OtherState, m%Inflow(i), ErrStat2, ErrMsg2) + call AD_CalcWind(utimes(i), u(i), p%FLowField, p, m, OtherState, m%Inflow(i), ErrStat2, ErrMsg2) if (Failed()) return enddo @@ -1734,7 +1829,7 @@ subroutine AD_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, errStat if (Failed()) return ! Calculate wind using uInterp - call AD_CalcWind(utimes(i),uInterp, p%FLowField, p, OtherState, m%Inflow(1), ErrStat2, ErrMsg2) + call AD_CalcWind(utimes(i),uInterp, p%FLowField, p, m, OtherState, m%Inflow(1), ErrStat2, ErrMsg2) if (Failed()) return do iR = 1,size(p%rotors) @@ -1793,11 +1888,12 @@ logical function Failed() end function Failed end subroutine AD_UpdateStates -subroutine AD_CalcWind(t, u, FLowField, p, o, Inflow, ErrStat, ErrMsg) +subroutine AD_CalcWind(t, u, FLowField, p, m, o, Inflow, ErrStat, ErrMsg) real(DbKi), intent(in ) :: t !< Current simulation time in seconds type(AD_InputType), intent(in ) :: u !< Inputs at Time t type(FlowFieldType),pointer, intent(in ) :: FlowField type(AD_ParameterType), intent(in ) :: p !< Parameters + type(AD_MiscVarType), intent(inout) :: m !< Misc/optimization variables type(AD_OtherStateType), intent(in ) :: o !< Other states at t type(AD_InflowType),target, intent(inout) :: Inflow !< calculated inflow integer(IntKi), intent( out) :: ErrStat !< Error status of the operation @@ -1821,7 +1917,7 @@ subroutine AD_CalcWind(t, u, FLowField, p, o, Inflow, ErrStat, ErrMsg) StartNode = 1 do iWT = 1, size(u%rotors) - call AD_CalcWind_Rotor(t, u%rotors(iWT), FLowField, p%rotors(iWT), Inflow%RotInflow(iWT), StartNode, ErrStat2, ErrMsg2) + call AD_CalcWind_Rotor(t, u%rotors(iWT), FLowField, p%rotors(iWT), p, m, Inflow%RotInflow(iWT), StartNode, ErrStat2, ErrMsg2) if(Failed()) return enddo @@ -1850,11 +1946,13 @@ logical function Failed() end function Failed end subroutine -subroutine AD_CalcWind_Rotor(t, u, FlowField, p, RotInflow, StartNode, ErrStat, ErrMsg) +subroutine AD_CalcWind_Rotor(t, u, FlowField, p, p_AD, m, RotInflow, StartNode, ErrStat, ErrMsg) real(DbKi), intent(in ) :: t !< Current simulation time in seconds type(RotInputType), intent(in ) :: u !< Inputs at Time t type(FlowFieldType),pointer, intent(in ) :: FlowField type(RotParameterType), intent(in ) :: p !< Parameters + type(AD_ParameterType), intent(in ) :: p_AD !< AD parameters + type(AD_MiscVarType), intent(inout) :: m !< Misc/optimization variables type(RotInflowType), intent(inout) :: RotInflow !< calculated inflow for rotor integer(IntKi), intent(inout) :: StartNode !< starting node for rotor wind integer(IntKi), intent( out) :: ErrStat !< Error status of the operation @@ -1878,55 +1976,108 @@ subroutine AD_CalcWind_Rotor(t, u, FlowField, p, RotInflow, StartNode, ErrStat, PosOffset = 0.0_ReKi end if - ! Hub - if (u%HubMotion%Committed) then - call IfW_FlowField_GetVelAcc(FlowField, StartNode, t, & - real(u%HubMotion%TranslationDisp + u%HubMotion%Position, ReKi), & - RotInflow%InflowOnHub, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) - if(Failed()) return - else - RotInflow%InflowOnHub = 0.0_ReKi - end if - StartNode = StartNode + 1 + if (p%MHK > 0 .and. p_AD%CompSeaSt) then ! MHK turbines with waves + ! Hub + if (u%HubMotion%Committed) then + call WaveField_GetWaveVelAcc_AD(p_AD%WaveField, m%WaveField_m, StartNode, t, & + real(u%HubMotion%TranslationDisp + u%HubMotion%Position, ReKi), & + RotInflow%InflowOnHub, NoAcc, ErrStat2, ErrMsg2) + if(Failed()) return + else + RotInflow%InflowOnHub = 0.0_ReKi + end if + StartNode = StartNode + 1 - ! Blade - do k = 1, p%NumBlades - call IfW_FlowField_GetVelAcc(FlowField, StartNode, t, & - real(u%BladeMotion(k)%TranslationDisp + u%BladeMotion(k)%Position, ReKi), & - RotInflow%Blade(k)%InflowVel, RotInflow%Blade(k)%InflowAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) - if(Failed()) return - StartNode = StartNode + p%NumBlNds - end do + ! Blade + do k = 1, p%NumBlades + call WaveField_GetWaveVelAcc_AD(p_AD%WaveField, m%WaveField_m, StartNode, t, & + real(u%BladeMotion(k)%TranslationDisp + u%BladeMotion(k)%Position, ReKi), & + RotInflow%Blade(k)%InflowVel, RotInflow%Blade(k)%InflowAcc, ErrStat2, ErrMsg2) + if(Failed()) return + StartNode = StartNode + p%NumBlNds + end do - ! Tower - if (u%TowerMotion%Nnodes > 0) then - call IfW_FlowField_GetVelAcc(FlowField, StartNode, t, & - real(u%TowerMotion%TranslationDisp + u%TowerMotion%Position, ReKi), & - RotInflow%Tower%InflowVel, RotInflow%Tower%InflowAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) - if(Failed()) return - StartNode = StartNode + p%NumTwrNds - end if + ! Tower + if (u%TowerMotion%Nnodes > 0) then + call WaveField_GetWaveVelAcc_AD(p_AD%WaveField, m%WaveField_m, StartNode, t, & + real(u%TowerMotion%TranslationDisp + u%TowerMotion%Position, ReKi), & + RotInflow%Tower%InflowVel, RotInflow%Tower%InflowAcc, ErrStat2, ErrMsg2) + if(Failed()) return + StartNode = StartNode + p%NumTwrNds + end if - ! Nacelle - if (u%NacelleMotion%Committed) then - call IfW_FlowField_GetVelAcc(FlowField, StartNode, t, & - real(u%NacelleMotion%TranslationDisp + u%NacelleMotion%Position, ReKi), & - RotInflow%InflowOnNacelle, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) - if(Failed()) return - StartNode = StartNode + 1 - else - RotInflow%InflowOnNacelle = 0.0_ReKi - end if + ! Nacelle + if (u%NacelleMotion%Committed) then + call WaveField_GetWaveVelAcc_AD(p_AD%WaveField, m%WaveField_m, StartNode, t, & + real(u%NacelleMotion%TranslationDisp + u%NacelleMotion%Position, ReKi), & + RotInflow%InflowOnNacelle, NoAcc, ErrStat2, ErrMsg2) + if(Failed()) return + StartNode = StartNode + 1 + else + RotInflow%InflowOnNacelle = 0.0_ReKi + end if - ! TailFin - if (u%TFinMotion%Committed) then - call IfW_FlowField_GetVelAcc(FlowField, StartNode, t, & - real(u%TFinMotion%TranslationDisp + u%TFinMotion%Position, ReKi), & - RotInflow%InflowOnTailFin, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) - if(Failed()) return + ! TailFin + if (u%TFinMotion%Committed) then + call WaveField_GetWaveVelAcc_AD(p_AD%WaveField, m%WaveField_m, StartNode, t, & + real(u%TFinMotion%TranslationDisp + u%TFinMotion%Position, ReKi), & + RotInflow%InflowOnTailFin, NoAcc, ErrStat2, ErrMsg2) + if(Failed()) return + StartNode = StartNode + 1 + else + RotInflow%InflowOnTailFin = 0.0_ReKi + end if + else ! Wind turbines or MHK turbines without waves + ! Hub + if (u%HubMotion%Committed) then + call IfW_FlowField_GetVelAcc(FlowField, StartNode, t, & + real(u%HubMotion%TranslationDisp + u%HubMotion%Position, ReKi), & + RotInflow%InflowOnHub, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) + if(Failed()) return + else + RotInflow%InflowOnHub = 0.0_ReKi + end if StartNode = StartNode + 1 - else - RotInflow%InflowOnTailFin = 0.0_ReKi + + ! Blade + do k = 1, p%NumBlades + call IfW_FlowField_GetVelAcc(FlowField, StartNode, t, & + real(u%BladeMotion(k)%TranslationDisp + u%BladeMotion(k)%Position, ReKi), & + RotInflow%Blade(k)%InflowVel, RotInflow%Blade(k)%InflowAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) + if(Failed()) return + StartNode = StartNode + p%NumBlNds + end do + + ! Tower + if (u%TowerMotion%Nnodes > 0) then + call IfW_FlowField_GetVelAcc(FlowField, StartNode, t, & + real(u%TowerMotion%TranslationDisp + u%TowerMotion%Position, ReKi), & + RotInflow%Tower%InflowVel, RotInflow%Tower%InflowAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) + if(Failed()) return + StartNode = StartNode + p%NumTwrNds + end if + + ! Nacelle + if (u%NacelleMotion%Committed) then + call IfW_FlowField_GetVelAcc(FlowField, StartNode, t, & + real(u%NacelleMotion%TranslationDisp + u%NacelleMotion%Position, ReKi), & + RotInflow%InflowOnNacelle, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) + if(Failed()) return + StartNode = StartNode + 1 + else + RotInflow%InflowOnNacelle = 0.0_ReKi + end if + + ! TailFin + if (u%TFinMotion%Committed) then + call IfW_FlowField_GetVelAcc(FlowField, StartNode, t, & + real(u%TFinMotion%TranslationDisp + u%TFinMotion%Position, ReKi), & + RotInflow%InflowOnTailFin, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) + if(Failed()) return + StartNode = StartNode + 1 + else + RotInflow%InflowOnTailFin = 0.0_ReKi + end if end if contains @@ -1978,7 +2129,7 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, end if ! Calculate wind based on current positions - call AD_CalcWind(t, u, p%FlowField, p, OtherState, m%Inflow(1), ErrStat2, ErrMsg2) + call AD_CalcWind(t, u, p%FlowField, p, m, OtherState, m%Inflow(1), ErrStat2, ErrMsg2) if(Failed()) return ! SetInputs, Calc BEM Outputs and Twr Outputs @@ -2002,31 +2153,9 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, endif ! Cavitation check - call AD_CavtCrit(u, p, m, errStat2, errMsg2) + call RotCavtCrit(u, p, m, errStat2, errMsg2) if(Failed()) return - ! initialize nacelle mesh loads - do iR = 1,size(p%rotors) - y%rotors(iR)%NacelleLoad%Force = 0.0_ReKi - y%rotors(iR)%NacelleLoad%Moment = 0.0_ReKi - end do - - ! Calculate buoyant loads - do iR = 1,size(p%rotors) - if ( p%rotors(iR)%Buoyancy ) then - call CalcBuoyantLoads( u%rotors(iR), p%rotors(iR), m%rotors(iR), y%rotors(iR), ErrStat, ErrMsg ) - if(Failed()) return - end if - end do - - ! Calculate nacelle drag loads - do iR = 1,size(p%rotors) - if ( p%rotors(iR)%NacelleDrag ) then - call computeNacelleDrag( u%rotors(iR), p%rotors(iR), m%rotors(iR), y%rotors(iR), m%Inflow(1)%RotInflow(iR), ErrStat, ErrMsg ) - if(Failed()) return - end if - end do - !------------------------------------------------------- ! get values to output to file: !------------------------------------------------------- @@ -2114,6 +2243,28 @@ subroutine RotCalcOutput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) endif + ! initialize nacelle mesh loads + y%NacelleLoad%Force = 0.0_ReKi + y%NacelleLoad%Moment = 0.0_ReKi + + ! Calculate buoyant loads + if ( p%MHK > 0 ) then + call RotCalcBuoyantLoads(u, p, m, y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if + + ! Calculate nacelle drag loads + if (p%NacelleDrag) then + call RotCalcNacelleDrag(u, p, m, y, RotInflow, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if + + ! Calculate added mass and fluid inertia loads + if ( p%MHK > 0 ) then + call RotCalcAddedMassInertiaLoads(u, p, m, y, RotInflow, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if + ! --- Tail Fin if (p%TFinAero) then call TFin_CalcOutput(p, p_AD, u, RotInflow, m, y, ErrStat2, ErrMsg2) @@ -2202,7 +2353,7 @@ subroutine RotWriteOutputs( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m end subroutine RotWriteOutputs !---------------------------------------------------------------------------------------------------------------------------------- -subroutine AD_CavtCrit(u, p, m, errStat, errMsg) +subroutine RotCavtCrit(u, p, m, errStat, errMsg) TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at time t TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables @@ -2251,10 +2402,10 @@ subroutine AD_CavtCrit(u, p, m, errStat, errMsg) end do ! p%numBlades end if ! Cavitation check end do ! p%numRotors -end subroutine AD_CavtCrit +end subroutine RotCavtCrit !---------------------------------------------------------------------------------------------------------------------------------- !> This routine calculates buoyant loads on an MHK turbine. -subroutine CalcBuoyantLoads( u, p, m, y, ErrStat, ErrMsg ) +subroutine RotCalcBuoyantLoads( u, p, m, y, ErrStat, ErrMsg ) TYPE(RotInputType), INTENT(IN ) :: u !< AD inputs - used for mesh node positions TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters TYPE(RotMiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables @@ -2324,7 +2475,7 @@ subroutine CalcBuoyantLoads( u, p, m, y, ErrStat, ErrMsg ) REAL(ReKi), DIMENSION(3,p%NumBlades) :: MovmomentBR !< Moment from moving blade root buoyant force from blade root to hub center REAL(ReKi), DIMENSION(3) :: MovvectorTT !< Vector from nacelle reference position to center of buoyancy of tower top REAL(ReKi), DIMENSION(3) :: MovmomentTT !< Moment from moving tower top buoyant force from tower top to nacelle reference position - CHARACTER(*), PARAMETER :: RoutineName = 'CalcBuoyantLoads' + CHARACTER(*), PARAMETER :: RoutineName = 'RotCalcBuoyantLoads' ! Initialize variables for this routine @@ -2348,7 +2499,7 @@ subroutine CalcBuoyantLoads( u, p, m, y, ErrStat, ErrMsg ) ! Check that blade nodes do not go beneath the seabed or pierce the free surface if ( u%BladeMotion(k)%Position(3,j) + u%BladeMotion(k)%TranslationDisp(3,j) >= p%MSL2SWL .OR. u%BladeMotion(k)%Position(3,j) + u%BladeMotion(k)%TranslationDisp(3,j) <= -p%WtrDpth ) & - call SetErrStat( ErrID_Fatal, 'Blades cannot go beneath the seabed or pierce the free surface', ErrStat, ErrMsg, 'CalcBuoyantLoads' ) + call SetErrStat( ErrID_Fatal, 'Blades cannot go beneath the seabed or pierce the free surface', ErrStat, ErrMsg, 'RotCalcBuoyantLoads' ) if ( ErrStat >= AbortErrLev ) return end do ! j = nodes @@ -2461,17 +2612,30 @@ subroutine CalcBuoyantLoads( u, p, m, y, ErrStat, ErrMsg ) ! Tower if ( p%NumTwrNds > 0 ) then - do j = 1,p%NumTwrNds ! loop through all nodes - ! Check that tower nodes do not go beneath the seabed or pierce the free surface - if ( u%TowerMotion%Position(3,j) + u%TowerMotion%TranslationDisp(3,j) >= p%MSL2SWL .OR. u%TowerMotion%Position(3,j) + u%TowerMotion%TranslationDisp(3,j) < -p%WtrDpth ) & - call SetErrStat( ErrID_Fatal, 'The tower cannot go beneath the seabed or pierce the free surface', ErrStat, ErrMsg, 'CalcBuoyantLoads' ) + ! loop through all nodes + do j = 1, p%NumTwrNds + + ! Skip check for first node if this is a fixed bottom tower + if (j == 1 .and. p%MHK == MHK_FixedBottom) cycle + + ! Check that tower nodes do not go beneath the seabed or pierce the free surface + if ( u%TowerMotion%Position(3,j) + u%TowerMotion%TranslationDisp(3,j) >= p%MSL2SWL .OR. & + u%TowerMotion%Position(3,j) + u%TowerMotion%TranslationDisp(3,j) < -p%WtrDpth ) then + call SetErrStat( ErrID_Fatal, 'The tower cannot go beneath the seabed or pierce the free surface', ErrStat, ErrMsg, 'RotCalcBuoyantLoads' ) if ( ErrStat >= AbortErrLev ) return + end if end do do j = 1,p%NumTwrNds - 1 ! loop through all nodes, except the last ! Global position of tower node TwrtmpPos = u%TowerMotion%Position(:,j) + u%TowerMotion%TranslationDisp(:,j) - (/ 0.0_ReKi, 0.0_ReKi, p%MSL2SWL /) TwrtmpPosplus = u%TowerMotion%Position(:,j+1) + u%TowerMotion%TranslationDisp(:,j+1) - (/ 0.0_ReKi, 0.0_ReKi, p%MSL2SWL /) + + ! If base node on fixed bottom tower is below the water depth (during Jacobian perturbations), + ! clamp it to the water depth + if ((j == 1) .and. (p%MHK == MHK_FixedBottom) .and. (TwrtmpPos(3) < -p%WtrDpth)) then + TwrtmpPos(3) = -p%WtrDpth + end if ! Heading and inclination angles of tower element TwrheadAng = atan2( TwrtmpPosplus(2) - TwrtmpPos(2), TwrtmpPosplus(1) - TwrtmpPos(1) ) @@ -2554,7 +2718,7 @@ subroutine CalcBuoyantLoads( u, p, m, y, ErrStat, ErrMsg ) else ! Check that hub node does not go beneath the seabed or pierce the free surface if ( u%HubMotion%Position(3,1) + u%HubMotion%TranslationDisp(3,1) >= p%MSL2SWL .OR. u%HubMotion%Position(3,1) + u%HubMotion%TranslationDisp(3,1) <= -p%WtrDpth ) & - call SetErrStat( ErrID_Fatal, 'The hub cannot go beneath the seabed or pierce the free surface', ErrStat, ErrMsg, 'CalcBuoyantLoads' ) + call SetErrStat( ErrID_Fatal, 'The hub cannot go beneath the seabed or pierce the free surface', ErrStat, ErrMsg, 'RotCalcBuoyantLoads' ) if ( ErrStat >= AbortErrLev ) return ! Global position of hub node @@ -2608,7 +2772,7 @@ subroutine CalcBuoyantLoads( u, p, m, y, ErrStat, ErrMsg ) else ! Check that nacelle node does not go beneath the seabed or pierce the free surface if ( u%NacelleMotion%Position(3,1) + u%NacelleMotion%TranslationDisp(3,1) >= p%MSL2SWL .OR. u%NacelleMotion%Position(3,1) + u%NacelleMotion%TranslationDisp(3,1) <= -p%WtrDpth ) & - call SetErrStat( ErrID_Fatal, 'The nacelle cannot go beneath the seabed or pierce the free surface', ErrStat, ErrMsg, 'CalcBuoyantLoads' ) + call SetErrStat( ErrID_Fatal, 'The nacelle cannot go beneath the seabed or pierce the free surface', ErrStat, ErrMsg, 'RotCalcBuoyantLoads' ) if ( ErrStat >= AbortErrLev ) return ! Global position of nacelle node @@ -2652,7 +2816,122 @@ subroutine CalcBuoyantLoads( u, p, m, y, ErrStat, ErrMsg ) m%NacMi = y%NacelleLoad%Moment(:,1) -end subroutine CalcBuoyantLoads +end subroutine RotCalcBuoyantLoads +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine calculates added mass and fluid inertia loads on an MHK turbine. +subroutine RotCalcAddedMassInertiaLoads( u, p, m, y, RotInflow, ErrStat, ErrMsg ) + TYPE(RotInputType), INTENT(IN ) :: u !< AD inputs - used for mesh node positions + TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters + TYPE(RotMiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + TYPE(RotOutputType), INTENT(INOUT) :: y !< Outputs computed at t + TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor inflow + 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 counter for blades + INTEGER(IntKi) :: j !< Loop counter for nodes + REAL(ReKi), DIMENSION(3) :: aFBTemp !< Inflow acceleration at blade node in local coordinates + REAL(ReKi), DIMENSION(3) :: aBBTemp !< Body translational acceleration at blade node in local coordinates + REAL(ReKi), DIMENSION(3) :: alphaBBTemp !< Body rotational acceleration at blade node in local coordinates + REAL(ReKi), DIMENSION(3) :: BlFItmp !< Inertia force at blade node in local coordinates + REAL(ReKi), DIMENSION(3) :: BlFAtmp !< Added mass force at blade node in local coordinates + REAL(ReKi), DIMENSION(3) :: BlMAtmp !< Added mass moment at blade node in local coordinates + REAL(ReKi), DIMENSION(3) :: aFTTemp !< Inflow acceleration at tower node in local coordinates + REAL(ReKi), DIMENSION(3) :: aBTTemp !< Body translational acceleration at tower node in local coordinates + REAL(ReKi), DIMENSION(3) :: TwrFItmp !< Inertia force at tower node in local coordinates + REAL(ReKi), DIMENSION(3) :: TwrFAtmp !< Added mass force at tower node in local coordinates + CHARACTER(*), PARAMETER :: RoutineName = 'RotCalcAddedMassInertiaLoads' + + + ! Initialize variables for this routine + ErrStat = ErrID_None + ErrMsg = "" + aFBTemp = 0.0_ReKi + aBBTemp = 0.0_ReKi + alphaBBTemp = 0.0_ReKi + BlFItmp = 0.0_ReKi + BlFAtmp = 0.0_ReKi + BlMAtmp = 0.0_ReKi + aFTTemp = 0.0_ReKi + aBTTemp = 0.0_ReKi + TwrFItmp = 0.0_ReKi + TwrFAtmp = 0.0_ReKi + + ! Blades + do k = 1,p%NumBlades ! loop through all blades + do j = 1,p%NumBlNds ! loop through all nodes + + ! Convert fluid acceleration at node to local blade coordinates + aFBTemp = matmul( u%BladeMotion(k)%Orientation(:,:,j), RotInflow%Blade(k)%InflowAcc(:,j) ) + + ! Calculate per-unit-length inertia forces at node + BlFItmp(1) = p%BlIN(j,k) * aFBTemp(1) + BlFItmp(2) = p%BlIT(j,k) * aFBTemp(2) + + ! Convert inertia forces to global coordinates + m%BlFI(:,j,k) = matmul( transpose(u%BladeMotion(k)%Orientation(:,:,j)), BlFItmp ) + + ! Convert body acceleration at node to local blade coordinates + aBBTemp = matmul( u%BladeMotion(k)%Orientation(:,:,j), u%BladeMotion(k)%TranslationAcc(:,j) ) + alphaBBTemp(3) = u%BladeMotion(k)%Orientation(3,1,j)*u%BladeMotion(k)%RotationAcc(1,j) + u%BladeMotion(k)%Orientation(3,2,j)*u%BladeMotion(k)%RotationAcc(2,j) + u%BladeMotion(k)%Orientation(3,3,j)*u%BladeMotion(k)%RotationAcc(3,j) + + ! Calculate per-unit-length added mass forces at node + BlFAtmp(1) = p%BlAN(j,k) * aBBTemp(1) + BlFAtmp(2) = p%BlAT(j,k) * aBBTemp(2) + + ! Calculate per-unit-length added mass pitching moment at node + BlMAtmp(3) = p%BlAM(j,k) * alphaBBTemp(3) + + ! Convert added mass forces and moments to global coordinates + m%BlFA(:,j,k) = matmul( transpose(u%BladeMotion(k)%Orientation(:,:,j)), BlFAtmp ) + m%BlMA(:,j,k) = matmul( transpose(u%BladeMotion(k)%Orientation(:,:,j)), BlMAtmp ) + + end do + end do + + ! Add added mass and inertia loads to aerodynamic loads + do k = 1,p%NumBlades ! loop through all blades + do j = 1,p%NumBlNds ! loop through all nodes + y%BladeLoad(k)%Force(:,j) = y%BladeLoad(k)%Force(:,j) + m%BlFI(:,j,k) + m%BlFA(:,j,k) + y%BladeLoad(k)%Moment(:,j) = y%BladeLoad(k)%Moment(:,j) + m%BlMA(:,j,k) + end do ! j = nodes + end do ! k = blades + + ! Tower + if ( p%NumTwrNds > 0 ) then + do j = 1,p%NumTwrNds ! loop through all nodes + + ! Convert fluid acceleration at node to local tower coordinates + aFTTemp = matmul( u%TowerMotion%Orientation(:,:,j), RotInflow%Tower%InflowAcc(:,j) ) + + ! Calculate per-unit-length inertia forces at node + TwrFItmp(1) = p%TwrIT(j) * aFTTemp(1) + TwrFItmp(2) = p%TwrIT(j) * aFTTemp(2) + + ! Convert inertia forces to global coordinates + m%TwrFI(:,j) = matmul( transpose(u%TowerMotion%Orientation(:,:,j)), TwrFItmp ) + + ! Convert body acceleration at node to local tower coordinates + aBTTemp = matmul( u%TowerMotion%Orientation(:,:,j), u%TowerMotion%TranslationAcc(:,j) ) + + ! Calculate per-unit-length added mass forces at node + TwrFAtmp(1) = p%TwrAT(j) * aBTTemp(1) + TwrFAtmp(2) = p%TwrAT(j) * aBTTemp(2) + + ! Convert added mass forces to global coordinates + m%TwrFA(:,j) = matmul( transpose(u%TowerMotion%Orientation(:,:,j)), TwrFAtmp ) + + end do + end if + + ! Add buoyant loads to aerodynamic loads + do j = 1,p%NumTwrNds ! loop through all nodes + y%TowerLoad%Force(:,j) = y%TowerLoad%Force(:,j) + m%TwrFI(:,j) + m%TwrFA(:,j) + end do ! j = nodes + +end subroutine RotCalcAddedMassInertiaLoads !---------------------------------------------------------------------------------------------------------------------------------- !> Tight coupling routine for solving for the residual of the constraint state equations subroutine AD_CalcConstrStateResidual( Time, u, p, x, xd, z, OtherState, m, z_residual, ErrStat, ErrMsg ) @@ -3824,7 +4103,6 @@ subroutine SetOutputsFromFVW(t, u, p, OtherState, x, xd, m, y, ErrStat, ErrMsg) real(ReKi) :: Cx, Cy real(ReKi) :: Cl_Static, Cd_Static, Cm_Static, Cpmin real(ReKi) :: Cl_dyn, Cd_dyn, Cm_dyn - type(UA_InputType), pointer :: u_UA ! Alias to shorten notations integer(IntKi), parameter :: InputIndex=1 ! we will always use values at t in this routine integer(intKi) :: iR, iW integer(intKi) :: ErrStat2 @@ -3864,21 +4142,22 @@ subroutine SetOutputsFromFVW(t, u, p, OtherState, x, xd, m, y, ErrStat, ErrMsg) Cm_dyn = AFI_interp%Cm if (p%UA_Flag) then - u_UA => m%FVW%W(iW)%u_UA(j,InputIndex) ! Alias - ! ....... compute inputs to UA ........... - u_UA%alpha = alpha - u_UA%U = Vrel - u_UA%Re = Re - ! calculated in m%FVW%u_UA??? :u_UA%UserProp = 0.0_ReKi ! FIX ME - - u_UA%v_ac(1) = sin(u_UA%alpha)*u_UA%U - u_UA%v_ac(2) = cos(u_UA%alpha)*u_UA%U - ! calculated in m%FVW%u_UA??? : u_UA%omega = dot_product( u%rotors(iR)%BladeMotion(k)%RotationVel( :,j), m%rotors(iR)%orientationAnnulus(3,:,j,k) ) ! rotation of no-sweep-pitch coordinate system around z of the jth node in the kth blade - call UA_CalcOutput(j, 1, t, u_UA, m%FVW%W(iW)%p_UA, x%FVW%UA(iW), xd%FVW%UA(iW), OtherState%FVW%UA(iW), p%AFI(p%FVW%W(iW)%AFindx(j,1)), m%FVW%W(iW)%y_UA, m%FVW%W(iW)%m_UA, errStat2, errMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SetOutputsFromFVW') - Cl_dyn = m%FVW%W(iW)%y_UA%Cl - Cd_dyn = m%FVW%W(iW)%y_UA%Cd - Cm_dyn = m%FVW%W(iW)%y_UA%Cm + associate(u_UA => m%FVW%W(iW)%u_UA(j,InputIndex)) + ! ....... compute inputs to UA ........... + u_UA%alpha = alpha + u_UA%U = Vrel + u_UA%Re = Re + ! calculated in m%FVW%u_UA??? :u_UA%UserProp = 0.0_ReKi ! FIX ME + + u_UA%v_ac(1) = sin(u_UA%alpha)*u_UA%U + u_UA%v_ac(2) = cos(u_UA%alpha)*u_UA%U + ! calculated in m%FVW%u_UA??? : u_UA%omega = dot_product( u%rotors(iR)%BladeMotion(k)%RotationVel( :,j), m%rotors(iR)%orientationAnnulus(3,:,j,k) ) ! rotation of no-sweep-pitch coordinate system around z of the jth node in the kth blade + call UA_CalcOutput(j, 1, t, u_UA, m%FVW%W(iW)%p_UA, x%FVW%UA(iW), xd%FVW%UA(iW), OtherState%FVW%UA(iW), p%AFI(p%FVW%W(iW)%AFindx(j,1)), m%FVW%W(iW)%y_UA, m%FVW%W(iW)%m_UA, errStat2, errMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SetOutputsFromFVW') + Cl_dyn = m%FVW%W(iW)%y_UA%Cl + Cd_dyn = m%FVW%W(iW)%y_UA%Cd + Cm_dyn = m%FVW%W(iW)%y_UA%Cm + end associate end if cp = cos(phi) sp = sin(phi) @@ -3959,6 +4238,8 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, calcCrvAngle, ErrSt ! local variables + real(ReKi) :: BlCbSum + real(ReKi) :: TwrCbSum integer(IntKi) :: k ! Blade number integer(IntKi) :: j ! node number integer(IntKi) :: iR ! rotor index @@ -4021,7 +4302,6 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, calcCrvAngle, ErrSt if (Failed()) return if (InitInp%MHK == MHK_None .and. InputFileData%CavitCheck) call SetErrStat ( ErrID_Fatal, 'A cavitation check can only be performed for an MHK turbine.', ErrStat, ErrMsg, RoutineName ) - if (InitInp%MHK == MHK_None .and. InputFileData%Buoyancy) call SetErrStat ( ErrID_Fatal, 'Buoyancy can only be calculated for an MHK turbine.', ErrStat, ErrMsg, RoutineName ) if (InitInp%MHK /= MHK_None .and. InputFileData%CompAA ) call SetErrStat ( ErrID_Fatal, 'The aeroacoustics module cannot be used with an MHK turbine.', ErrStat, ErrMsg, RoutineName ) do iR = 1,size(NumBl) if (InitInp%MHK /= MHK_None .and. InputFileData%rotors(iR)%TFinAero) call SetErrStat ( ErrID_Fatal, 'A tail fin cannot be modeled for an MHK turbine.', ErrStat, ErrMsg, RoutineName ) @@ -4121,15 +4401,36 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, calcCrvAngle, ErrSt end do ! j=nodes end do ! k=blades - ! If the Buoyancy flag is True, check that the blade buoyancy coefficients are >= 0. - if ( InputFileData%Buoyancy ) then + ! If the MHK flag is set to 1 or 2, check that the blade buoyancy and added mass coefficients are >= 0. + if ( InitInp%MHK > 0 ) then do k=1,NumBl(iR) + BlCbSum = 0.0_ReKi do j=1,InputFileData%rotors(iR)%BladeProps(k)%NumBlNds if ( InputFileData%rotors(iR)%BladeProps(k)%BlCb(j) < 0.0_ReKi ) then call SetErrStat( ErrID_Fatal, 'The buoyancy coefficient for blade '//trim(Num2LStr(k))//' node '//trim(Num2LStr(j)) & //' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) endif + if ( InputFileData%rotors(iR)%BladeProps(k)%t_c(j) < 0.0_ReKi ) then + call SetErrStat( ErrID_Fatal, 'The thickness to chord ratio for blade '//trim(Num2LStr(k))//' node '//trim(Num2LStr(j)) & + //' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) + endif + if ( InputFileData%rotors(iR)%BladeProps(k)%BlCan(j) < 0.0_ReKi ) then + call SetErrStat( ErrID_Fatal, 'The chordwise added mass coefficient for blade '//trim(Num2LStr(k))//' node '//trim(Num2LStr(j)) & + //' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) + endif + if ( InputFileData%rotors(iR)%BladeProps(k)%BlCat(j) < 0.0_ReKi ) then + call SetErrStat( ErrID_Fatal, 'The edgewise added mass coefficient for blade '//trim(Num2LStr(k))//' node '//trim(Num2LStr(j)) & + //' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) + endif + if ( InputFileData%rotors(iR)%BladeProps(k)%BlCam(j) < 0.0_ReKi ) then + call SetErrStat( ErrID_Fatal, 'The pitch added mass coefficient for blade '//trim(Num2LStr(k))//' node '//trim(Num2LStr(j)) & + //' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) + endif + BlCbSum = BlCbSum + InputFileData%rotors(iR)%BladeProps(k)%BlCb(j) end do ! j=nodes + if ( BlCbSum <= 0.0_ReKi .and. InputFileData%rotors(iR)%VolHub > 0.0_ReKi .or. InputFileData%rotors(iR)%VolHub <= 0.0_ReKi .and. BlCbSum > 0.0_ReKi ) then + call SetErrStat( ErrID_Fatal, 'If blade buoyancy is calculated, hub buoyancy must be calculated, and vice versa.', ErrStat, ErrMsg, RoutineName ) + endif end do ! k=blades end if end do ! iR rotor @@ -4138,7 +4439,7 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, calcCrvAngle, ErrSt ! ............................. ! check tower mesh data: ! ............................. - if (InputFileData%TwrPotent /= TwrPotent_none .or. InputFileData%TwrShadow /= TwrShadow_none .or. InputFileData%TwrAero /= TwrAero_none .or. InputFileData%Buoyancy) then + if (InputFileData%TwrPotent /= TwrPotent_none .or. InputFileData%TwrShadow /= TwrShadow_none .or. InputFileData%TwrAero /= TwrAero_none .or. InitInp%MHK > 0) then do iR = 1,size(NumBl) if (InputFileData%rotors(iR)%NumTwrNds <= 0) cycle !bjj: this could be removed since the loops here already take into account the number of tower nodes @@ -4169,13 +4470,22 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, calcCrvAngle, ErrSt end do ! j=nodes end if - ! If the Buoyancy flag is True, check that the tower buoyancy coefficients are >= 0. - if ( InputFileData%Buoyancy .and. InputFileData%rotors(iR)%NumTwrNds > 0 ) then + ! If the MHK flag is set to 1 or 2, check that the tower buoyancy and added mass coefficients are >= 0. + if ( InitInp%MHK > 0 .and. InputFileData%rotors(iR)%NumTwrNds > 0 ) then + TwrCbSum = 0.0_ReKi do j=1,InputFileData%rotors(iR)%NumTwrNds if ( InputFileData%rotors(iR)%TwrCb(j) < 0.0_ReKi ) then call SetErrStat( ErrID_Fatal, 'The buoyancy coefficient for tower node '//trim(Num2LStr(j))//' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) endif + + if ( InputFileData%rotors(iR)%TwrCa(j) < 0.0_ReKi ) then + call SetErrStat( ErrID_Fatal, 'The added mass coefficient for tower node '//trim(Num2LStr(j))//' must be greater than or equal to 0.', ErrStat, ErrMsg, RoutineName ) + endif + TwrCbSum = TwrCbSum + InputFileData%rotors(iR)%TwrCb(j) end do ! j=nodes + if ( TwrCbSum <= 0.0_ReKi .and. InputFileData%rotors(iR)%VolNac > 0.0_ReKi .or. InputFileData%rotors(iR)%VolNac <= 0.0_ReKi .and. TwrCbSum > 0.0_ReKi ) then + call SetErrStat( ErrID_Fatal, 'If tower buoyancy is calculated, nacelle buoyancy must be calculated, and vice versa.', ErrStat, ErrMsg, RoutineName ) + endif end if end do ! iR rotor end if ! using the tower @@ -4187,7 +4497,7 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, calcCrvAngle, ErrSt ! ............................. ! check hub mesh data: ! ............................. - if ( InputFileData%Buoyancy ) then + if ( InitInp%MHK > 0 ) then ! Check that the hub volume is >= 0. do iR = 1,size(NumBl) @@ -4201,7 +4511,7 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, calcCrvAngle, ErrSt ! ............................. ! check nacelle mesh data: ! ............................. - if ( InputFileData%Buoyancy ) then + if ( InitInp%MHK > 0 ) then ! Check that the nacelle volume is >= 0. do iR = 1,size(NumBl) @@ -5627,47 +5937,342 @@ SUBROUTINE TwrInfl_NearestPoint(p, u, RotInflow, BladeNodePosition, r_TowerBlade END SUBROUTINE TwrInfl_NearestPoint !---------------------------------------------------------------------------------------------------------------------------------- -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -! ###### The following four routines are Jacobian routines for linearization capabilities ####### -! If the module does not implement them, set ErrStat = ErrID_Fatal in AD_Init() when InitInp%Linearize is .true. -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions -!! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. -SUBROUTINE 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); - 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 - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with - integer(IntKi), parameter :: iR =1 ! Rotor index - integer(intKi) :: StartNode - - StartNode = 1 ! ignored during linearization since cannot linearize with ExtInflow - if (size(p%rotors)>1) then - errStat = ErrID_Fatal - errMsg = 'Linearization with more than one rotor not supported' - return - endif +subroutine AD_InitVars(iR, u, p, x, z, OtherState, y, m, InitOut, InputFileData, Linearize, CompAeroMaps, ErrStat, ErrMsg) + integer(IntKi), intent(in) :: iR !< Rotor number + type(RotInputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(RotParameterType), intent(inout) :: p !< Parameters + type(RotContinuousStateType), intent(inout) :: x !< States + type(RotConstraintStateType), intent(inout) :: z !< Constraint state type + type(RotOtherStateType), intent(inout) :: OtherState !< Other state type + type(RotOutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(RotMiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(RotInitOutputType), intent(inout) :: InitOut !< Output for initialization routine + type(RotInputFile), intent(in) :: InputFileData !< Input file data + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + logical, intent(in) :: CompAeroMaps !< Flag to compute aero maps + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'Init_ModuleVars' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(4) :: RotorLabel + character(64) :: NodeLabel + character(1), parameter :: UVW(3) = ['U','V','W'] + real(R8Ki) :: Perturb, PerturbTower, PerturbBlade(MaxBl) + integer(IntKi) :: i, j, n, state, Flags + logical :: LinearizeLoc - call AD_CalcWind_Rotor( t, u%rotors(iR), p%FLowField, p%rotors(iR), m%Inflow(1)%RotInflow(iR), StartNode, ErrStat, ErrMsg) - call Rot_JacobianPInput( t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) + ErrStat = ErrID_None + ErrMsg = "" -END SUBROUTINE AD_JacobianPInput + ! Combine linearization flags + LinearizeLoc = Linearize .or. CompAeroMaps .or. (p%MHK /= MHK_None) + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Add pointers to vars to initialization output + InitOut%Vars => p%Vars + + ! Create rotor label + RotorLabel = 'R'//trim(Num2LStr(iR)) + + !---------------------------------------------------------------------------- + ! Perturbation values + !---------------------------------------------------------------------------- + + Perturb = 2.0_R8Ki * D2R_D + + do i = 1, p%NumBlades + PerturbBlade(i) = 0.2_R8Ki * D2R_D * InputFileData%BladeProps(i)%BlSpn(InputFileData%BladeProps(i)%NumBlNds) + end do + + if (u%TowerMotion%NNodes > 0) then + PerturbTower = 0.2_R8Ki * D2R_D * u%TowerMotion%Position(3, u%TowerMotion%NNodes) + else + PerturbTower = 0.0_R8Ki + end if + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + allocate(p%Vars%x(0)) + + ! DBEMT + if (p%BEMT%DBEMT%lin_nx/2 > 0) then + do j = 1, p%NumBlades + do i = 1, p%NumBlNds + call MV_AddVar(p%Vars%x, "DBEMT%Element%vind", FieldScalar, & + DatLoc(AD_x_BEMT_DBEMT_element_vind, i, j), & + Num=2, & + Flags=ior(VF_DerivOrder2, VF_RotFrame), & + Perturb=Perturb, & + LinNames=[DBEMTLinName(j, i, "axial", .false.), & + DBEMTLinName(j, i, "tangential", .false.)]) + end do + end do + do j = 1, p%NumBlades + do i = 1, p%NumBlNds + call MV_AddVar(p%Vars%x, "DBEMT%Element%vind_1", FieldScalar, & + DatLoc(AD_x_BEMT_DBEMT_element_vind_1, i, j), & + Num=2, & + Flags=ior(VF_DerivOrder2, VF_RotFrame), & + Perturb=Perturb, & + LinNames=[DBEMTLinName(j, i, "axial", .true.), & + DBEMTLinName(j, i, "tangential", .true.)]) + end do + end do + end if + + ! Unsteady Aero + do n = 1, p%BEMT%UA%lin_nx + + i = p%BEMT%UA%lin_xIndx(n,1) + j = p%BEMT%UA%lin_xIndx(n,2) + state = p%BEMT%UA%lin_xIndx(n,3) + + select case (state) + case (1, 2) ! x1 and x2 are radians + NodeLabel = 'x'//trim(Num2Lstr(state))//' blade '//trim(Num2Lstr(j))//', node '//trim(Num2Lstr(i))//', rad' + case (3, 4, 5) ! x3, x4 (and x5) are units of cl or cn + NodeLabel = 'x'//trim(Num2Lstr(state))//' blade '//trim(Num2Lstr(j))//', node '//trim(Num2Lstr(i))//', -' + end select + + call MV_AddVar(p%Vars%x, NodeLabel, FieldScalar, & + DatLoc(AD_x_BEMT_UA_element_x, i, j), iAry=state, & + Flags=ior(VF_DerivOrder1, VF_RotFrame), & + Perturb=p%BEMT%UA%dx(state), & + LinNames=[NodeLabel]) + end do + + ! BEMT states + if (p%BEMT%lin_nx>0) then + call SetErrStat(ErrID_Fatal, 'Number of lin states for bem should be zero', ErrStat, ErrMsg, RoutineName) + return + end if + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + ! Add Nacelle motion + call MV_AddMeshVar(p%Vars%u, "Nacelle", [FieldTransDisp, FieldOrientation], & + DatLoc(AD_u_NacelleMotion), & + Mesh=u%NacelleMotion, & + Perturbs=[PerturbBlade(1), Perturb]) + + ! Add hub motion + call MV_AddMeshVar(p%Vars%u, "Hub", [FieldTransDisp, FieldOrientation, FieldAngularVel], & + DatLoc(AD_u_HubMotion), & + Mesh=u%HubMotion, & + Perturbs=[PerturbBlade(1), Perturb, Perturb]) + + ! Add tail fin motion + call MV_AddMeshVar(p%Vars%u, "TFin", [FieldTransDisp, FieldOrientation, FieldTransVel], & + DatLoc(AD_u_TFinMotion), & + Mesh=u%TFinMotion, & + Perturbs=[Perturb, Perturb, Perturb]) + + ! Add tower motion + call MV_AddMeshVar(p%Vars%u, "Tower", [FieldTransDisp, FieldOrientation, FieldTransVel, FieldTransAcc], & + DatLoc(AD_u_TowerMotion), & + Mesh=u%TowerMotion, & + Flags=VF_SmallAngle, & + Perturbs=[PerturbTower, Perturb, PerturbTower, PerturbTower]) + + ! Add blade root motion + do j = 1, p%NumBlades + call MV_AddMeshVar(p%Vars%u, "Blade root "//Num2LStr(j), [FieldOrientation], & + DatLoc(AD_u_BladeRootMotion, j), & + Mesh=u%BladeRootMotion(j), & + Perturbs=[Perturb]) + end do + + ! Add blade motion + do j = 1, p%NumBlades + Flags = VF_None + if (j == 1) Flags = VF_AeroMap + call MV_AddMeshVar(p%Vars%u, "Blade "//Num2LStr(j), [FieldTransDisp, FieldOrientation, FieldTransVel], & + DatLoc(AD_u_BladeMotion, j), & + Flags=Flags, & + Mesh=u%BladeMotion(j), & + Perturbs=[PerturbBlade(j), Perturb, PerturbBlade(j)]) + call MV_AddMeshVar(p%Vars%u, "Blade "//Num2LStr(j), [FieldAngularVel, FieldTransAcc, FieldAngularAcc], & + DatLoc(AD_u_BladeMotion, j), & + Mesh=u%BladeMotion(j), & + Perturbs=[Perturb, PerturbBlade(j), Perturb]) + end do + + ! Add user props + do j = 1, p%NumBlades + call MV_AddVar(p%Vars%u, "UserProp Blade"//IdxStr(j), FieldScalar, DatLoc(AD_u_UserProp), jAry=j, & + Flags=VF_Linearize + VF_RotFrame, & + Num=p%NumBlNds, & + Perturb=Perturb, & + LinNames=[('User property on blade '//trim(Num2LStr(j))//', node '//trim(Num2LStr(i))//', -', i = 1, p%NumBlNds)]) + end do + + ! Extended inputs + call MV_AddVar(p%Vars%u, "HWindSpeed", FieldScalar, DatLoc(AD_u_HWindSpeed), & + Flags=VF_ExtLin + VF_Linearize, & + Perturb=Perturb, & + LinNames=['Extended input: horizontal wind speed (steady/uniform wind), m/s']) + + call MV_AddVar(p%Vars%u, "PLExp", FieldScalar, DatLoc(AD_u_PLexp), & + Flags=VF_ExtLin + VF_Linearize, & + Perturb=Perturb, & + LinNames=['Extended input: vertical power-law shear exponent, -']) + + call MV_AddVar(p%Vars%u, "PropagationDir", FieldScalar, DatLoc(AD_u_PropagationDir), & + Flags=VF_ExtLin + VF_Linearize, & + Perturb=Perturb, & + LinNames=['Extended input: propagation direction, rad']) + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + ! Add nacelle load + call MV_AddMeshVar(p%Vars%y, "Nacelle", LoadFields, DatLoc(AD_y_NacelleLoad), & + Mesh=y%NacelleLoad) + + ! Add hub load + call MV_AddMeshVar(p%Vars%y, "Hub", LoadFields, DatLoc(AD_y_HubLoad), & + Mesh=y%HubLoad) + + ! Add tail fin load + call MV_AddMeshVar(p%Vars%y, "TFin", LoadFields, DatLoc(AD_y_TFinLoad), & + Mesh=y%TFinLoad) + + ! Add tower load + call MV_AddMeshVar(p%Vars%y, "Tower", LoadFields, DatLoc(AD_y_TowerLoad), & + Mesh=y%TowerLoad) + + ! Loop through blades, add blade loads + do j = 1, p%NumBlades + Flags = VF_Line + if (j == 1) Flags = ior(Flags, VF_AeroMap) + call MV_AddMeshVar(p%Vars%y, "Blade "//Num2LStr(j), LoadFields, DatLoc(AD_y_BladeLoad, j), & + Flags=Flags, & + Mesh=y%BladeLoad(j)) + end do + + ! Rotor outputs + do j = 1, p%NumOuts + call MV_AddVar(p%Vars%y, InitOut%WriteOutputHdr(j), FieldScalar, & + DatLoc(AD_y_WriteOutput), iAry=j, & + Flags=VF_WriteOut + OutParamFlags(p%OutParam(j)%Indx), & + LinNames=[trim(InitOut%WriteOutputHdr(j))//', '//trim(InitOut%WriteOutputUnt(j))]) + end do + + ! Blade node outputs + do j = p%NumOuts + 1, p%NumOuts + p%BldNd_TotNumOuts + call MV_AddVar(p%Vars%y, InitOut%WriteOutputHdr(j), FieldScalar, & + DatLoc(AD_y_WriteOutput), iAry=j, & + Flags=VF_WriteOut + VF_RotFrame, & + LinNames=[trim(InitOut%WriteOutputHdr(j))//', '//trim(InitOut%WriteOutputUnt(j))]) + end do + + !---------------------------------------------------------------------------- + ! Initialize Variables and Linearization data + !---------------------------------------------------------------------------- + + call MV_InitVarsJac(p%Vars, m%Jac, LinearizeLoc, ErrStat2, ErrMsg2); if (Failed()) return + + if (LinearizeLoc) then + call AD_CopyRotContinuousStateType(x, m%x_init, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotContinuousStateType(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotContinuousStateType(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotInputType(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOutputType(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOtherStateType(OtherState, m%OtherState_init, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOtherStateType(OtherState, m%OtherState_jac, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotConstraintStateType(z, m%z_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + end if + +contains + + character(LinChanLen) function DBEMTLinName(BladeNum, NodeNum, Direction, Deriv) + integer(IntKi), intent(in) :: BladeNum, NodeNum + character(*), intent(in) :: Direction + logical, intent(in) :: Deriv + DBEMTLinName = 'vind ('//trim(Direction)//') at blade '//trim(Num2LStr(BladeNum))//', node '//trim(Num2LStr(NodeNum))//', m/s' + if (Deriv) DBEMTLinName = 'First time derivative of '//trim(DBEMTLinName)//"/s" + end function + + pure integer(IntKi) function OutParamFlags(ind) + integer(IntKi), intent(in) :: ind + integer(IntKi), parameter :: RotFrameInds(*) = [& + BAzimuth, BPitch, & + BNVUndx, BNVUndy, BNVUndz, BNVDisx, BNVDisy, BNVDisz, BNSTVx, BNSTVy, & + BNSTVz, BNVRel, BNDynP, BNRe, BNM, BNVIndx, BNVIndy, BNAxInd, BNTnInd, & + BNAlpha, BNTheta, BNPhi, BNCurve, BNCl, BNCd, BNCm, BNCx, BNCy, BNCn, & + BNCt, BNFl, BNFd, BNMm, BNFx, BNFy, BNFn, BNFt, BNClrnc] + if (any(RotFrameInds == ind)) then + OutParamFlags = VF_RotFrame + else + OutParamFlags = VF_None + end if + end function + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! ###### The following four routines are Jacobian routines for linearization capabilities ####### +! If the module does not implement them, set ErrStat = ErrID_Fatal in AD_Init() when InitInp%Linearize is .true. +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions +!! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. +SUBROUTINE AD_JacobianPInput(Vars, iRotor, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +!.................................................................................................................................. + + type(ModVarsType), INTENT(IN ) :: Vars !< Module vars + INTEGER(IntKi), INTENT(IN ) :: iRotor !< Rotor index + 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); + 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 + + integer(intKi) :: StartNode + + StartNode = 1 ! ignored during linearization since cannot linearize with ExtInflow + + call AD_CalcWind_Rotor(t, u%rotors(iRotor), p%FlowField, p%rotors(iRotor), p, m, m%Inflow(1)%RotInflow(iRotor), StartNode, ErrStat, ErrMsg) + if (ErrStat >= AbortErrLev) return + call Rot_JacobianPInput(Vars, iRotor, t, u%rotors(iRotor), m%Inflow(1)%RotInflow(iRotor), p%rotors(iRotor), p, x%rotors(iRotor), xd%rotors(iRotor), z%rotors(iRotor), OtherState%rotors(iRotor), y%rotors(iRotor), m%rotors(iRotor), m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) + +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 Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +SUBROUTINE Rot_JacobianPInput(Vars, iRotor, t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +!.................................................................................................................................. + use IfW_FlowField, only: FlowFieldType, UniformField_InterpLinear + type(ModVarsType), INTENT(IN ) :: Vars !< Module variables for packing arrays + INTEGER(IntKi), INTENT(IN ) :: iRotor !< Rotor index REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(RotInputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor inflow @@ -5680,225 +6285,220 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y TYPE(RotOutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); TYPE(RotMiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables TYPE(AD_MiscVarType), INTENT(INOUT) :: m_AD !< misc variables - INTEGER, INTENT(IN ) :: iRot !< Rotor index, needed for OLAF 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) - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) - ! local variables - TYPE(RotOutputType) :: y_p - TYPE(RotOutputType) :: y_m - TYPE(RotContinuousStateType) :: x_p - TYPE(RotContinuousStateType) :: x_m - TYPE(RotContinuousStateType) :: x_init - TYPE(RotConstraintStateType) :: z_copy - TYPE(RotOtherStateType) :: OtherState_copy - TYPE(RotOtherStateType) :: OtherState_init - TYPE(RotInputType) :: u_perturb - type(FLowFieldType),target :: FlowField_perturb - type(FLowFieldType),pointer :: FlowField_perturb_p ! need a pointer in the CalcWind_Rotor routine - type(RotInflowType) :: RotInflow_perturb !< Rotor inflow, perturbed by FlowField extended inputs - REAL(R8Ki) :: delta_p, delta_m ! delta change in input - INTEGER(IntKi) :: i - - integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'Rot_JacobianPInput' - + 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] + + character(*), parameter :: RoutineName = 'AD_JacobianPInput' + integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + type(RotOtherStateType) :: OtherState_copy + integer(IntKi) :: i, j, col, StartNode + integer(IntKi) :: iVarHWindSpeed, iVarPLexp, iVarPropagationDir + type(UniformField_Interp) :: UF_op + type(FlowFieldType),target :: FF_perturb + type(FlowFieldType),pointer :: FF_ptr ! need a pointer in the CalcWind_Rotor routine + type(RotInflowType) :: RotInflow_perturb !< Rotor inflow, perturbed by FlowField extended inputs - ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' - ! get OP values here (i.e., set inputs for BEMT): - if ( p%DBEMT_Mod == DBEMT_frozen ) then - call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2); if (Failed()) return - - ! compare m%BEMT_y arguments with call to BEMT_CalcOutput - call computeFrozenWake(m%BEMT_u(indx), p%BEMT, m%BEMT_y, m%BEMT ) + ! Find indices for extended input variables + iVarHWindSpeed = 0 + iVarPLexp = 0 + iVarPropagationDir = 0 + do i = 1, size(Vars%u) + select case(Vars%u(i)%DL%Num) + case (AD_u_HWindSpeed) + iVarHWindSpeed = i + case (AD_u_PLexp) + iVarPLexp = i + case (AD_u_PropagationDir) + iVarPropagationDir = i + end select + end do + + ! If flow field will need to be perturbed (HWindSpeed, PLexp, or PropagationDir variables) + if (iVarHWindSpeed > 0 .or. iVarPLexp > 0 .or. iVarPropagationDir > 0) then + ! Copy the flow field (Uniform type, which as minimal data) + call IfW_FlowField_CopyFlowFieldType(p_AD%FlowField, FF_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + FF_ptr => FF_perturb + else + ! Otherwise, associate flowfield pointer to flowfield in parameters since it won't be modified + FF_ptr => p_AD%FlowField + end if + + ! Get OP values here (i.e., set inputs for BEMT): + if (p%DBEMT_Mod == DBEMT_frozen) then + call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2); if (Failed()) return + + ! compare m%BEMT_y arguments with call to BEMT_CalcOutput + call computeFrozenWake(m%BEMT_u(indx), p%BEMT, m%BEMT_y, m%BEMT) m%BEMT%UseFrozenWake = .true. end if - - call AD_CopyRotContinuousStateType( x, x_init, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); if (Failed()) return - call AD_CopyRotOtherStateType( OtherState, OtherState_init, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - ! Copy FlowField data -- ideally we would not do this, but we cannot linearize with turbulent winds - call IfW_FlowField_CopyFlowFieldType(p_AD%FlowField, FlowField_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - FlowField_perturb_p => FlowField_perturb - call AD_CopyRotInflowType( RotInflow, RotInflow_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + ! Copy continuous and other states for initialization + call AD_CopyRotContinuousStateType(x, m%x_init, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOtherStateType(OtherState, m%OtherState_init, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - ! initialize x_init so that we get accurrate values for first step - if (.not. OtherState%BEMT%nodesInitialized ) then + ! Initialize x_init so that we get accurrate values for first step + ! changes values only if states haven't been initialized + if (.not. OtherState%BEMT%nodesInitialized) then call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2); if (Failed()) return - call BEMT_InitStates(t, m%BEMT_u(indx), p%BEMT, x_init%BEMT, xd%BEMT, z%BEMT, OtherState_init%BEMT, m%BEMT, p_AD%AFI, ErrStat2, ErrMsg2 ) ! changes values only if states haven't been initialized - if (Failed()) return + call BEMT_InitStates(t, m%BEMT_u(indx), p%BEMT, m%x_init%BEMT, xd%BEMT, z%BEMT, & + m%OtherState_init%BEMT, m%BEMT, p_AD%AFI, ErrStat2, ErrMsg2); if (Failed()) return end if + + ! Copy inputs and pack them for perturbation + call AD_CopyRotInputType(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_VarsPackInput(Vars, u, m%Jac%u) - - ! make a copy of the inputs to perturb - call AD_CopyRotInputType( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - - - 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); if (Failed()) return + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + if (present(dYdu)) then + + ! Allocate dYdu if not allocated + if (.not. allocated(dYdu)) then + call AllocAry(dYdu, Vars%Ny, Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if + ! Copy rotor inflow type for perturbation + call AD_CopyRotInflowType(RotInflow, RotInflow_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + + ! Loop through input variables + do i = 1, size(Vars%u) - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call AD_CopyRotOutputType( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotOutputType( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - ! make a copy of the states to perturb - call AD_CopyRotConstraintStateType( z, z_copy, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotOtherStateType( OtherState_init, OtherState_copy, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - - - do i=1,size(p%Jac_u_indx,1) - - ! get u_op + delta_p u - call IfW_FlowField_CopyFlowFieldType(p_AD%FlowField, FlowField_perturb_p, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotInflowType( RotInflow, RotInflow_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return - call Perturb_u( p, i, 1, u_perturb, delta_p ) - call Perturb_uExtend( t, u_perturb, FlowField_perturb_p, RotInflow_perturb, p, OtherState, i, 1, u_perturb, delta_p, ErrStat2, ErrMsg2); if (Failed()) return - - call AD_CopyRotConstraintStateType( z, z_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotOtherStateType( OtherState_init, OtherState_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - - ! get updated z%phi values: - !bjj: this is what we want to do instead of the overkill of calling AD_UpdateStates - call SetInputs(t, p, p_AD, u_perturb, RotInflow_perturb, m, indx, errStat2, errMsg2); if (Failed()) return - call UpdatePhi( m%BEMT_u(indx), p%BEMT, z_copy%BEMT%phi, p_AD%AFI, m%BEMT, OtherState_copy%BEMT%ValidPhi, errStat2, errMsg2 ); if (Failed()) return - - ! compute y at u_op + delta_p u - call RotCalcOutput( t, u_perturb, RotInflow_perturb, p, p_AD, x_init, xd, z_copy, OtherState_copy, y_p, m, m_AD, iRot, ErrStat2, ErrMsg2 ); if (Failed()) return - + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%u(i)%Num - ! get u_op - delta_m u - call IfW_FlowField_CopyFlowFieldType(p_AD%FlowField, FlowField_perturb_p, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotInflowType( RotInflow, RotInflow_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return - call Perturb_u( p, i, -1, u_perturb, delta_m ) - call Perturb_uExtend( t, u_perturb, FlowField_perturb_p, RotInflow_perturb, p, OtherState, i, -1, u_perturb, delta_m, ErrStat2, ErrMsg2); if (Failed()) return + ! Calculate positive perturbation + call AD_CopyRotConstraintStateType(z, m%z_lin, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOtherStateType(m%OtherState_init, m%OtherState_jac, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call AD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(Vars%u(i), p_AD%FlowField, 1, FF_ptr) + StartNode = 1 + call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, p_AD, m_AD, RotInflow_perturb, StartNode, ErrStat2, ErrMsg2); if (Failed()) return + call SetInputs(t, p, p_AD, m%u_perturb, RotInflow_perturb, m, indx, ErrStat2, ErrMsg2); if (Failed()) return + call UpdatePhi(m%BEMT_u(indx), p%BEMT, m%z_lin%BEMT%phi, p_AD%AFI, m%BEMT, m%OtherState_jac%BEMT%ValidPhi, ErrStat2, ErrMsg2); if (Failed()) return + call RotCalcOutput(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, m%z_lin, m%OtherState_jac, m%y_lin, m, m_AD, iRotor, ErrStat2, ErrMsg2); if (Failed()) return + call AD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) - call AD_CopyRotConstraintStateType( z, z_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotOtherStateType( OtherState, OtherState_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - - ! get updated z%phi values: - call SetInputs(t, p, p_AD, u_perturb, RotInflow_perturb, m, indx, errStat2, errMsg2); if (Failed()) return - call UpdatePhi( m%BEMT_u(indx), p%BEMT, z_copy%BEMT%phi, p_AD%AFI, m%BEMT, OtherState_copy%BEMT%ValidPhi, errStat2, errMsg2 ); if (Failed()) return + ! Calculate negative perturbation + call AD_CopyRotConstraintStateType(z, m%z_lin, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOtherStateType(m%OtherState_init, m%OtherState_jac, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call AD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(Vars%u(i), p_AD%FlowField, -1, FF_ptr) + StartNode = 1 + call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, p_AD, m_AD, RotInflow_perturb, StartNode, ErrStat2, ErrMsg2); if (Failed()) return + call SetInputs(t, p, p_AD, m%u_perturb, RotInflow_perturb, m, indx, ErrStat2, ErrMsg2); if (Failed()) return + call UpdatePhi(m%BEMT_u(indx), p%BEMT, m%z_lin%BEMT%phi, p_AD%AFI, m%BEMT, m%OtherState_jac%BEMT%ValidPhi, ErrStat2, ErrMsg2); if (Failed()) return + call RotCalcOutput(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, m%z_lin, m%OtherState_jac, m%y_lin, m, m_AD, iRotor, ErrStat2, ErrMsg2); if (Failed()) return + call AD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) + + ! Calculate column index + col = Vars%u(i)%iLoc(1) + j - 1 - ! compute y at u_op - delta_m u - call RotCalcOutput( t, u_perturb, RotInflow_perturb, p, p_AD, x_init, xd, z_copy, OtherState_copy, y_m, m, m_AD, iRot, ErrStat2, ErrMsg2 ); if (Failed()) return - - ! get central difference: - call Compute_dY( p, p_AD, y_p, y_m, delta_p, delta_m, dYdu(:,i) ) - - end do - - - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - END IF + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(Vars%y, Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) + end do - IF ( PRESENT( dXdu ) ) THEN + end do + end if - ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + if (present(dXdu) .and. (Vars%Nx > 0)) then - ! allocate dXdu if necessary + ! Allocate dXdu if not allocated if (.not. allocated(dXdu)) then - call AllocAry(dXdu, size(p%dx), size(p%Jac_u_indx,1), 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(dXdu, m%Jac%Nx, m%Jac%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return end if - - - do i=1,size(p%Jac_u_indx,1) - - ! get u_op + delta u - call IfW_FlowField_CopyFlowFieldType(p_AD%FlowField, FlowField_perturb_p, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotInflowType( RotInflow, RotInflow_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return - call Perturb_u( p, i, 1, u_perturb, delta_p ) - call Perturb_uExtend( t, u_perturb, FlowField_perturb_p, RotInflow_perturb, p, OtherState, i, 1, u_perturb, delta_p, ErrStat2, ErrMsg2); if (Failed()) return - - ! compute x at u_op + delta u - ! note that this routine updates z%phi instead of using the actual state value, so we don't need to call UpdateStates/UpdatePhi here to get z_op + delta_z: - call RotCalcContStateDeriv( t, u_perturb, RotInflow_perturb, p, p_AD, x_init, xd, z, OtherState_init, m, x_p, ErrStat2, ErrMsg2 ); if (Failed()) return - - ! get u_op - delta u - call IfW_FlowField_CopyFlowFieldType(p_AD%FlowField, FlowField_perturb_p, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotInflowType( RotInflow, RotInflow_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return - call Perturb_u( p, i, -1, u_perturb, delta_m ) - call Perturb_uExtend( t, u_perturb, FlowField_perturb_p, RotInflow_perturb, p, OtherState, i, -1, u_perturb, delta_m, ErrStat2, ErrMsg2); if (Failed()) return - - ! compute x at u_op - delta u - ! note that this routine updates z%phi instead of using the actual state value, so we don't need to call UpdateStates here to get z_op + delta_z: - call RotCalcContStateDeriv( t, u_perturb, RotInflow_perturb, p, p_AD, x_init, xd, z, OtherState_init, m, x_m, ErrStat2, ErrMsg2 ); if (Failed()) return - - - ! get central difference: - - ! we may have had an error allocating memory, so we'll check - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - ! get central difference: - call Compute_dX( p, x_p, x_m, delta_p, delta_m, dXdu(:,i) ) - end do + ! Loop through input variables + do i = 1, size(Vars%u) + + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%u(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call AD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(Vars%u(i), p_AD%FlowField, 1, FF_ptr) + StartNode = 1 + call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, p_AD, m_AD, RotInflow_perturb, StartNode, ErrStat2, ErrMsg2); if (Failed()) return + call RotCalcContStateDeriv(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2) ; if (Failed()) return + call AD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call AD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + if (associated(FF_ptr, FF_perturb)) call PerturbFlowField(Vars%u(i), p_AD%FlowField, -1, FF_ptr) + StartNode = 1 + call AD_CalcWind_Rotor(t, m%u_perturb, FF_ptr, p, p_AD, m_AD, RotInflow_perturb, StartNode, ErrStat2, ErrMsg2); if (Failed()) return + call RotCalcContStateDeriv(t, m%u_perturb, RotInflow_perturb, p, p_AD, m%x_init, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2) ; if (Failed()) return + call AD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_neg) + + ! Calculate column index + col = Vars%u(i)%iLoc(1) + j - 1 - call AD_DestroyRotContinuousStateType( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call AD_DestroyRotContinuousStateType( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - END IF + + ! Get partial derivative via central difference and store in full linearization array + dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%u(i)%Perturb) + end do + end do + + end if - IF ( PRESENT( dXddu ) ) THEN + if (present(dXddu)) then if (allocated(dXddu)) deallocate(dXddu) - END IF + end if - IF ( PRESENT( dZdu ) ) THEN + if (present(dZdu)) then if (allocated(dZdu)) deallocate(dZdu) - END IF + end if call cleanup() contains + subroutine PerturbFlowField(Var, BaseFF, PerturbSign, PerturbFF) + type(ModVarType), intent(in) :: Var + type(FlowFieldType), intent(in) :: BaseFF + integer(IntKi), intent(in) :: PerturbSign + type(FlowFieldType), intent(inout) :: PerturbFF + PerturbFF%Uniform%VelH = BaseFF%Uniform%VelH + PerturbFF%Uniform%ShrV = BaseFF%Uniform%ShrV + PerturbFF%PropagationDir = BaseFF%PropagationDir + select case (Var%DL%Num) + case (AD_u_HWindSpeed) + PerturbFF%Uniform%VelH = BaseFF%Uniform%VelH + Var%Perturb*PerturbSign + case (AD_u_PLexp) + PerturbFF%Uniform%ShrV = BaseFF%Uniform%ShrV + Var%Perturb*PerturbSign + case (AD_u_PropagationDir) + PerturbFF%PropagationDir = BaseFF%PropagationDir + Var%Perturb*PerturbSign + end select + end subroutine + logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev - if (Failed) call Cleanup() - end function Failed + if (Failed) call cleanup() + end function subroutine cleanup() m%BEMT%UseFrozenWake = .false. - call AD_DestroyRotOutputType( y_p, ErrStat2, ErrMsg2) - call AD_DestroyRotOutputType( y_m, ErrStat2, ErrMsg2) - call AD_DestroyRotContinuousStateType( x_p, ErrStat2, ErrMsg2) - call AD_DestroyRotContinuousStateType( x_m, ErrStat2, ErrMsg2) - call AD_DestroyRotContinuousStateType( x_init, ErrStat2, ErrMsg2) - call AD_DestroyRotConstraintStateType( z_copy, ErrStat2, ErrMsg2) - call AD_DestroyRotOtherStateType( OtherState_copy, ErrStat2, ErrMsg2) - call AD_DestroyRotOtherStateType( OtherState_init, ErrStat2, ErrMsg2) - call AD_DestroyRotInputType( u_perturb, ErrStat2, ErrMsg2 ) - call AD_DestroyRotInflowType( RotInflow_perturb, ErrStat2, ErrMsg2 ) - call IfW_FlowField_DestroyFlowFieldType( FlowField_perturb, ErrStat2, ErrMsg2 ) end subroutine cleanup -END SUBROUTINE Rot_JacobianPInput +end subroutine Rot_JacobianPInput !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE AD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) +SUBROUTINE AD_JacobianPContState(Vars, iRotor, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx) !.................................................................................................................................. + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables for packing arrays + INTEGER(IntKi), INTENT(IN ) :: iRotor !< Rotor index REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -5925,26 +6525,23 @@ SUBROUTINE AD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state !! functions (Z) with respect to !! the continuous states (x) [intent in to avoid deallocation] - ! - integer(IntKi), parameter :: iR =1 ! Rotor index - - if (size(p%rotors)>1) then - errStat = ErrID_Fatal - errMsg = 'Linearization with more than one rotor not supported' - return - endif - - call RotJacobianPContState( t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) + integer(IntKi) :: StartNode + StartNode = 1 + call AD_CalcWind_Rotor(t, u%rotors(iRotor), p%FlowField, p%rotors(iRotor), p, m, m%Inflow(1)%RotInflow(iRotor), StartNode, ErrStat, ErrMsg) + if (ErrStat >= AbortErrLev) return + call RotJacobianPContState(Vars, iRotor, t, u%rotors(iRotor), m%Inflow(1)%RotInflow(iRotor), p%rotors(iRotor), p, x%rotors(iRotor), xd%rotors(iRotor), z%rotors(iRotor), OtherState%rotors(iRotor), y%rotors(iRotor), m%rotors(iRotor), m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx) END SUBROUTINE AD_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE RotJacobianPContState( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) +SUBROUTINE RotJacobianPContState(Vars, iRotor, t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx) !.................................................................................................................................. - + + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables for packing arrays + integer(IntKi), INTENT(IN ) :: iRotor !< Rotor index REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor inflow @@ -5960,169 +6557,136 @@ SUBROUTINE RotJacobianPContState( t, u, RotInflow, p, p_AD, x, xd, z, OtherState !! connectivity) does not have to be recalculated for dYdx. TYPE(RotMiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables TYPE(AD_MiscVarType), INTENT(INOUT) :: m_AD !< misc variables - INTEGER, INTENT(IN ) :: iRot !< Rotor index, needed for OLAF INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions - !! (Y) with respect to the continuous - !! states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state - !! functions (X) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state - !! functions (Xd) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state - !! functions (Z) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - - ! local variables - TYPE(RotOutputType) :: y_p - TYPE(RotOutputType) :: y_m - TYPE(RotContinuousStateType) :: x_p - TYPE(RotContinuousStateType) :: x_m - TYPE(RotContinuousStateType) :: x_perturb - TYPE(RotContinuousStateType) :: x_init - TYPE(RotOtherStateType) :: OtherState_init - REAL(R8Ki) :: delta_p, delta_m ! delta change in state - INTEGER(IntKi) :: i - - integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_JacobianPContState' + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions (Y) with respect to the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) with respect to the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) with respect to the continuous states (x) [intent in to avoid deallocation] - - ! Initialize ErrStat + character(*), parameter :: RoutineName = 'AD_JacobianPContState' + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt + integer(IntKi) :: i, j, col ErrStat = ErrID_None ErrMsg = '' + ! Get OP values here (i.e., set inputs for BEMT): + if (p%DBEMT_Mod == DBEMT_frozen) then + call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2); if (Failed()) return - if ( p%DBEMT_Mod == DBEMT_frozen ) then - call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2); if (Failed()) return; - - ! compare arguments with call to BEMT_CalcOutput - call computeFrozenWake(m%BEMT_u(indx), p%BEMT, m%BEMT_y, m%BEMT ) + ! compare m%BEMT_y arguments with call to BEMT_CalcOutput + call computeFrozenWake(m%BEMT_u(indx), p%BEMT, m%BEMT_y, m%BEMT) m%BEMT%UseFrozenWake = .true. end if - - call AD_CopyRotContinuousStateType( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); if (Failed()) return; - call AD_CopyRotContinuousStateType( x, x_init, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); if (Failed()) return; - call AD_CopyRotOtherStateType( OtherState, OtherState_init, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return; - - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + ! Copy continuous and other states for initialization + call AD_CopyRotContinuousStateType(x, m%x_init, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOtherStateType(OtherState, m%OtherState_init, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - ! initialize x_init so that we get accurrate values for - if (.not. OtherState%BEMT%nodesInitialized ) then - call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2); if (Failed()) return; - call BEMT_InitStates(t, m%BEMT_u(indx), p%BEMT, x_init%BEMT, xd%BEMT, z%BEMT, OtherState_init%BEMT, m%BEMT, p_AD%AFI, ErrStat2, ErrMsg2 ); if (Failed()) return; ! changes values only if states haven't been initialized + ! Initialize x_init so that we get accurrate values for first step + ! changes values only if states haven't been initialized + if (.not. OtherState%BEMT%nodesInitialized) then + call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2); if (Failed()) return + call BEMT_InitStates(t, m%BEMT_u(indx), p%BEMT, m%x_init%BEMT, xd%BEMT, z%BEMT, & + m%OtherState_init%BEMT, m%BEMT, p_AD%AFI, ErrStat2, ErrMsg2); if (Failed()) return end if - - - IF ( PRESENT( dYdx ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + ! Copy and pack states for perturbation + call AD_CopyRotContinuousStateType(m%x_init, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_VarsPackContState(Vars, m%x_init, m%Jac%x) + + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + if (present(dYdx)) then - ! allocate dYdx if necessary + ! Allocate dYdx if not allocated if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Jac_ny, size(p%dx), 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return; + call AllocAry(dYdx, m%Jac%Ny, m%Jac%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return end if - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call AD_CopyRotOutputType( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return; - call AD_CopyRotOutputType( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return; + ! Loop through state variables + do i = 1, size(Vars%x) - do i=1,size(p%dx) - - ! get x_op + delta_p x - call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return; - call Perturb_x( p, i, 1, x_perturb, delta_p ) + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%x(i)%Num + ! Calculate positive perturbation + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call AD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call RotCalcOutput(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m%y_lin, m, m_AD, iRotor, ErrStat2, ErrMsg2) ; if (Failed()) return + call AD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) - ! compute y at x_op + delta_p x - ! NOTE: z_op is the same as z because x_perturb does not affect the values of phi, thus I am not updating the states or calling UpdatePhi to get z_perturb. - call RotCalcOutput( t, u, RotInflow, p, p_AD, x_perturb, xd, z, OtherState_init, y_p, m, m_AD, iRot, ErrStat2, ErrMsg2 ) ; if (Failed()) return; - - - ! get x_op - delta_m x - call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return; - call Perturb_x( p, i, -1, x_perturb, delta_m ) - - ! compute y at x_op - delta_m x - ! NOTE: z_op is the same as z because x_perturb does not affect the values of phi, thus I am not updating the states or calling UpdatePhi to get z_perturb. - call RotCalcOutput( t, u, RotInflow, p, p_AD, x_perturb, xd, z, OtherState_init, y_m, m, m_AD, iRot, ErrStat2, ErrMsg2 ); if (Failed()) return; - - - ! get central difference: - call Compute_dY( p, p_AD, y_p, y_m, delta_p, delta_m, dYdx(:,i) ) - + ! Calculate negative perturbation + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call AD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call RotCalcOutput(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m%y_lin, m, m_AD, iRotor, ErrStat2, ErrMsg2) ; if (Failed()) return + call AD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) + + ! Calculate column index + col = Vars%x(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(Vars%y, Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) + end do end do - END IF + + end if - IF ( PRESENT( dXdx ) ) THEN + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + if (present(dXdx)) then - ! allocate dXdx if necessary + ! Allocate dXdx if not allocated if (.not. allocated(dXdx)) then - call AllocAry(dXdx, size(p%dx), size(p%dx), 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return; + call AllocAry(dXdx, m%Jac%Nx, m%Jac%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return end if - - - do i=1,size(p%dx,1) - - ! get x_op + delta x - call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return; - call Perturb_x( p, i, 1, x_perturb, delta_p ) - ! compute X at x_op + delta x - ! NOTE: z_op is the same as z because x_perturb does not affect the values of phi, thus I am not updating the states or calling UpdatePhi to get z_perturb. - call RotCalcContStateDeriv( t, u, RotInflow, p, p_AD, x_perturb, xd, z, OtherState_init, m, x_p, ErrStat2, ErrMsg2 ); if (Failed()) return; - - - ! get x_op - delta x - call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return; - call Perturb_x( p, i, -1, x_perturb, delta_m ) - - ! compute x at u_op - delta u - ! NOTE: z_op is the same as z because x_perturb does not affect the values of phi, thus I am not updating the states or calling UpdatePhi to get z_perturb. - call RotCalcContStateDeriv( t, u, RotInflow, p, p_AD, x_perturb, xd, z, OtherState_init, m, x_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - - - ! get central difference: - call Compute_dX( p, x_p, x_m, delta_p, delta_m, dXdx(:,i) ) + ! Loop through state variables + do i = 1, size(Vars%x) + + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%x(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call AD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call RotCalcContStateDeriv(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call AD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call AD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call RotCalcContStateDeriv(t, u, RotInflow, p, p_AD, m%x_perturb, xd, z, m%OtherState_init, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call AD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_neg) + ! Calculate column index + col = Vars%x(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference and store in full linearization array + dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%x(i)%Perturb) + end do end do - END IF -! IF ( PRESENT( dXddx ) ) THEN -! END IF + end if -! IF ( PRESENT( dZdx ) ) THEN -! END IF + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the continuous states (x) here: + if (present(dXddx)) then + end if + + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the continuous states (x) here: + if (present(dZdx)) then + end if call cleanup() contains logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev - if (Failed) call Cleanup() - end function Failed - + if (Failed) call cleanup() + end function subroutine cleanup() m%BEMT%UseFrozenWake = .false. - - call AD_DestroyRotOutputType( y_p, ErrStat2, ErrMsg2) - call AD_DestroyRotOutputType( y_m, ErrStat2, ErrMsg2) - call AD_DestroyRotContinuousStateType( x_p, ErrStat2, ErrMsg2) - call AD_DestroyRotContinuousStateType( x_m, ErrStat2, ErrMsg2) - - call AD_DestroyRotContinuousStateType( x_perturb, ErrStat2, ErrMsg2 ) - call AD_DestroyRotContinuousStateType( x_init, ErrStat2, ErrMsg2 ) - call AD_DestroyRotOtherStateType( OtherState_init, ErrStat2, ErrMsg2 ) end subroutine cleanup END SUBROUTINE RotJacobianPContState @@ -6130,7 +6694,8 @@ END SUBROUTINE RotJacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the discrete states (xd). The partial derivatives dY/dxd, dX/dxd, dXd/dxd, and dZ/dxd are returned. -SUBROUTINE AD_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) +SUBROUTINE AD_JacobianPDiscState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -6151,8 +6716,6 @@ SUBROUTINE AD_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrStat = ErrID_None ErrMsg = '' - return; ! nothing to do here - ! IF ( PRESENT( dYdxd ) ) THEN ! END IF ! @@ -6170,7 +6733,8 @@ END SUBROUTINE AD_JacobianPDiscState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the constraint states (z). The partial derivatives dY/dz, dX/dz, dXd/dz, and dZ/dz are returned. -SUBROUTINE AD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) +SUBROUTINE AD_JacobianPConstrState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -6188,6 +6752,7 @@ SUBROUTINE AD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdz(:,:) !< Partial derivatives of constraint integer(IntKi), parameter :: iR =1 ! Rotor index + integer(IntKi) :: StartNode if (size(p%rotors)>1) then errStat = ErrID_Fatal @@ -6195,7 +6760,10 @@ SUBROUTINE AD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat return endif - call RotJacobianPConstrState( t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, errStat, errMsg, dYdz, dXdz, dXddz, dZdz ) + StartNode = 1 + call AD_CalcWind_Rotor(t, u%rotors(iR), p%FlowField, p%rotors(iR), p, m, m%Inflow(1)%RotInflow(iR), StartNode, ErrStat, ErrMsg) + if (ErrStat >= AbortErrLev) return + call RotJacobianPConstrState(t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, errStat, errMsg, dYdz, dXdz, dXddz, dZdz) END SUBROUTINE AD_JacobianPConstrState @@ -6233,12 +6801,16 @@ SUBROUTINE RotJacobianPConstrState( t, u, RotInflow, p, p_AD, x, xd, z, OtherSta REAL(R8Ki) :: delta_p, delta_m ! delta change in state INTEGER(IntKi) :: i, j, k, n, k2, j2 - 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 + character(*), parameter :: RoutineName = 'AD_JacobianPConstrState' integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_JacobianPConstrState' - + 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 + + + ! local variables + + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' @@ -6393,1234 +6965,49 @@ end subroutine cleanup END SUBROUTINE RotJacobianPConstrState -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE AD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(AD_InputType), INTENT(IN ) :: 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(IN ) :: y !< Output at operating point - 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(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - ! - integer(IntKi), parameter :: iR =1 ! Rotor index - - if (size(p%rotors)>1) then - errStat = ErrID_Fatal - errMsg = 'Linearization with more than one rotor not supported' - return - endif - - call RotGetOP( t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), errStat, errMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) - -END SUBROUTINE AD_GetOP - -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> Routine to pack the data structures representing the operating points into arrays for linearization. -!! NOTE: the order here needs to exactly match the order in Init_Jacobian_u. -SUBROUTINE RotGetOP( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor Inflow at operating point (may change to inout if a mesh copy is required) - TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< Parameters - TYPE(RotContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(RotDiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(RotConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(RotOtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(RotOutputType), INTENT(IN ) :: y !< Output at operating point - TYPE(RotMiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - - INTEGER(IntKi) :: index, i, j, k, n - INTEGER(IntKi) :: nu - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_GetOP' - LOGICAL :: FieldMask(FIELDMASK_SIZE) - TYPE(RotContinuousStateType) :: dxdt - real(ReKi) :: OP_out(3) !< operating point of wind (HWindSpeed, PLexp, and AngleH) - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - - IF ( PRESENT( u_op ) ) THEN - nu = size(p%Jac_u_indx,1) - do i=1,p%NumBl_Lin - nu = nu + u%BladeMotion(i)%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - end do - - if (.not. p_AD%CompAeroMaps) then - nu = nu + u%NacelleMotion%NNodes * 6 & ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - + u%HubMotion%NNodes * 6 & ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - + u%TowerMotion%NNodes * 6 & ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - + u%TFinMotion%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - do i=1,p%NumBlades - nu = nu + u%BladeRootMotion(i)%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - end do - end if - - if (.not. allocated(u_op)) then - call AllocAry(u_op, nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return - end if - - - index = 1 - if (.not. p_AD%CompAeroMaps) then - !------------------------------ - ! Nacelle - ! Module/Mesh/Field: u%NacelleMotion%TranslationDisp - ! Module/Mesh/Field: u%NacelleMotion%Orientation - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_ORIENTATION) = .true. - call PackMotionMesh(u%NacelleMotion, u_op, index, FieldMask=FieldMask) - - !------------------------------ - ! Hub - ! Module/Mesh/Field: u%HubMotion%TranslationDisp - ! Module/Mesh/Field: u%HubMotion%Orientation - ! Module/Mesh/Field: u%HubMotion%RotationVel - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_ORIENTATION) = .true. - FieldMask(MASKID_ROTATIONVEL) = .true. - call PackMotionMesh(u%HubMotion, u_op, index, FieldMask=FieldMask) - - !------------------------------ - ! TailFin - ! Module/Mesh/Field: u%TFinMotion%TranslationDisp - ! Module/Mesh/Field: u%TFinMotion%Orientation - ! Module/Mesh/Field: u%TFinMotion%TranslationVel - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_ORIENTATION) = .true. - FieldMask(MASKID_TRANSLATIONVEL) = .true. - call PackMotionMesh(u%TFinMotion, u_op, index, FieldMask=FieldMask) - - !------------------------------ - ! Tower - ! Module/Mesh/Field: u%TowerMotion%TranslationDisp - ! Module/Mesh/Field: u%TowerMotion%Orientation - ! Module/Mesh/Field: u%TowerMotion%TranslationVel - ! Module/Mesh/Field: u%TowerMotion%TranslationAcc - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_ORIENTATION) = .true. - FieldMask(MASKID_TRANSLATIONVEL) = .true. - FieldMask(MASKID_TRANSLATIONACC) = .true. - call PackMotionMesh(u%TowerMotion, u_op, index, FieldMask=FieldMask) - - !------------------------------ - ! Blade Root - ! Module/Mesh/Field: u%BladeRootMotion(1)%Orientation - ! Module/Mesh/Field: u%BladeRootMotion(2)%Orientation - ! Module/Mesh/Field: u%BladeRootMotion(3)%Orientation - FieldMask = .false. - FieldMask(MASKID_ORIENTATION) = .true. - do k = 1,p%NumBlades - call PackMotionMesh(u%BladeRootMotion(k), u_op, index, FieldMask=FieldMask) - end do - endif - - - !------------------------------ - ! Blade - ! Module/Mesh/Field: u%BladeMotion(k)%TranslationDisp - ! Module/Mesh/Field: u%BladeMotion(k)%Orientation - ! Module/Mesh/Field: u%BladeMotion(k)%TranslationVel - ! Module/Mesh/Field: u%BladeMotion(k)%RotationVel - ! Module/Mesh/Field: u%BladeMotion(k)%TranslationAcc - ! Module/Mesh/Field: u%BladeMotion(k)%RotationalAcc - if (.not. p_AD%CompAeroMaps) then - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_ORIENTATION) = .true. - FieldMask(MASKID_TRANSLATIONVEL) = .true. - FieldMask(MASKID_ROTATIONVEL) = .true. - FieldMask(MASKID_TRANSLATIONACC) = .true. - FieldMask(MASKID_ROTATIONACC) = .true. - else - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_ORIENTATION) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - end if - do k=1,p%NumBl_Lin - call PackMotionMesh(u%BladeMotion(k), u_op, index, FieldMask=FieldMask) - end do - - if (.not. p_AD%CompAeroMaps) then - !------------------------------ - ! UserProp - ! Module/Mesh/Field: u%UserProp(:,:) - do k=1,p%NumBlades - do j = 1, size(u%UserProp,1) ! Number of nodes for a blade - u_op(index) = u%UserProp(j,k) - index = index + 1 - end do - end do - - !------------------------------ - ! Extended inputs -- Linearization is only possible with Steady or Uniform Wind, so take advantage of that here - ! Module/Mesh/Field: HWindSpeed = 37 - ! Module/Mesh/Field: PLexp = 38 - ! Module/Mesh/Field: PropagationDir = 39 - call IfW_UniformWind_GetOP(p_AD%FlowField%Uniform, t, .false. , OP_out) - ! HWindSpeed - u_op(index) = OP_out(1); index = index + 1 - ! PLexp - u_op(index) = OP_out(2); index = index + 1 - ! PropagationDir (include AngleH in calculation if any) - u_op(index) = OP_out(3) + p_AD%FlowField%PropagationDir; index = index + 1 - - end if - END IF - - IF ( PRESENT( y_op ) ) THEN - - if (.not. allocated(y_op)) then - call AllocAry(y_op, p%Jac_ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return - end if - - index = 1 - if (.not. p_AD%CompAeroMaps) then - call PackLoadMesh(y%NacelleLoad, y_op, index) - call PackLoadMesh(y%HubLoad, y_op, index) - call PackLoadMesh(y%TFinLoad, y_op, index) - call PackLoadMesh(y%TowerLoad, y_op, index) - endif - do k=1,p%NumBl_Lin - call PackLoadMesh(y%BladeLoad(k), y_op, index) - end do - - if (.not. p_AD%CompAeroMaps) then - index = index - 1 - do i=1,p%NumOuts + p%BldNd_TotNumOuts - y_op(i+index) = y%WriteOutput(i) - end do - end if - - END IF - - IF ( PRESENT( x_op ) ) THEN - - if (.not. allocated(x_op)) then - call AllocAry(x_op, p%BEMT%DBEMT%lin_nx + p%BEMT%UA%lin_nx + p%BEMT%lin_nx,'x_op',ErrStat2,ErrMsg2); if (Failed()) return - end if - - index = 1 - ! set linearization operating points: - if (p%BEMT%DBEMT%lin_nx>0) then - do j=1,p%NumBlades ! size(x%BEMT%DBEMT%element,2) - do i=1,p%NumBlNds ! size(x%BEMT%DBEMT%element,1) - do k=1,size(x%BEMT%DBEMT%element(i,j)%vind) - x_op(index) = x%BEMT%DBEMT%element(i,j)%vind(k) - index = index + 1 - end do - end do - end do - - do j=1,p%NumBlades ! size(x%BEMT%DBEMT%element,2) - do i=1,p%NumBlNds ! size(x%BEMT%DBEMT%element,1) - do k=1,size(x%BEMT%DBEMT%element(i,j)%vind_1) - x_op(index) = x%BEMT%DBEMT%element(i,j)%vind_1(k) - index = index + 1 - end do - end do - end do - end if - - ! UA states - if (p%BEMT%UA%lin_nx>0) then - do n=1,p%BEMT%UA%lin_nx - i = p%BEMT%UA%lin_xIndx(n,1) - j = p%BEMT%UA%lin_xIndx(n,2) - k = p%BEMT%UA%lin_xIndx(n,3) - x_op(index) = x%BEMT%UA%element(i,j)%x(k) - - index = index + 1 - end do - end if - - ! BEMT states - if (p%BEMT%lin_nx>0) then - !do k = 1,size(x%BEMT%V_w) - ! x_op(index) = x%BEMT%v_w(k) - ! index = index + 1 - !end do - end if - - END IF - - IF ( PRESENT( dx_op ) ) THEN - - if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%BEMT%DBEMT%lin_nx + p%BEMT%UA%lin_nx + p%BEMT%lin_nx,'dx_op',ErrStat2,ErrMsg2); if (Failed()) return - end if - - call RotCalcContStateDeriv(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, m, dxdt, ErrStat2, ErrMsg2); if (Failed()) return - - index = 1 - ! set linearization operating points: - if (p%BEMT%DBEMT%lin_nx>0) then - - do j=1,p%NumBlades ! size(dxdt%BEMT%DBEMT%element,2) - do i=1,p%NumBlNds ! size(dxdt%BEMT%DBEMT%element,1) - do k=1,size(dxdt%BEMT%DBEMT%element(i,j)%vind) - dx_op(index) = dxdt%BEMT%DBEMT%element(i,j)%vind(k) - index = index + 1 - end do - end do - end do - - do j=1,p%NumBlades ! size(dxdt%BEMT%DBEMT%element,2) - do i=1,p%NumBlNds ! size(dxdt%BEMT%DBEMT%element,1) - do k=1,size(dxdt%BEMT%DBEMT%element(i,j)%vind_1) - dx_op(index) = dxdt%BEMT%DBEMT%element(i,j)%vind_1(k) - index = index + 1 - end do - end do - end do - - end if - ! UA states derivatives - if (p%BEMT%UA%lin_nx>0) then - do n=1,p%BEMT%UA%lin_nx - i = p%BEMT%UA%lin_xIndx(n,1) - j = p%BEMT%UA%lin_xIndx(n,2) - k = p%BEMT%UA%lin_xIndx(n,3) - dx_op(index) = dxdt%BEMT%UA%element(i,j)%x(k) - - index = index + 1 - end do - end if - ! BEMT states derivatives - if (p%BEMT%lin_nx>0) then - ErrStat2=ErrID_Fatal - ErrMsg2='Number of lin states for bem should be zero for now.' - if (Failed()) return - !do k = 1,size(x%BEMT%V_w) - ! dx_op(index) = dxdt%BEMT%v_w(k) - ! index = index + 1 - !end do - end if - - - END IF - - IF ( PRESENT( xd_op ) ) THEN - - END IF - - IF ( PRESENT( z_op ) ) THEN - - if (.not. allocated(z_op)) then - call AllocAry(z_op, p%NumBlades*p%NumBlNds, 'z_op', ErrStat2, ErrMsg2); if (Failed()) return - end if - - - index = 1 - do k=1,p%NumBlades ! size(z%BEMT%Phi,2) - do i=1,p%NumBlNds ! size(z%BEMT%Phi,1) - z_op(index) = z%BEMT%phi(i,k) - index = index + 1 - end do - end do - - END IF - -contains - logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - if (Failed) call Cleanup() - end function Failed - - subroutine cleanup() - call AD_DestroyRotContinuousStateType( dxdt, ErrStat2, ErrMsg2) - end subroutine cleanup -END SUBROUTINE RotGetOP - - -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -SUBROUTINE Init_Jacobian_y( p, p_AD, y, InitOut, ErrStat, ErrMsg) - TYPE(RotParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(AD_ParameterType) , INTENT(INOUT) :: p_AD !< parameters - TYPE(RotOutputType) , INTENT(IN ) :: y !< outputs - TYPE(RotInitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) - 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, j, k, indx_next, indx_last - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Init_Jacobian_y' - logical, allocatable :: AllOut(:) - - - ErrStat = ErrID_None - ErrMsg = "" - - - ! determine how many outputs there are in the Jacobians - if (p_AD%CompAeroMaps) then - p%Jac_ny = 0 ! we skip tower and writeOutput values in the solve (note: y%TowerLoad%NNodes=0) - else - p%Jac_ny = y%NacelleLoad%NNodes * 6 & ! 3 forces + 3 moments at each node - + y%HubLoad%NNodes * 6 & ! 3 forces + 3 moments at each node - + y%TFinLoad%NNodes * 6 & ! 3 forces + 3 moments at each node - + y%TowerLoad%NNodes * 6 & ! 3 forces + 3 moments at each node - + p%NumOuts + p%BldNd_TotNumOuts ! WriteOutput values - end if - - do k=1,p%NumBl_Lin - p%Jac_ny = p%Jac_ny + y%BladeLoad(k)%NNodes * 6 ! 3 forces + 3 moments at each node - end do - - - ! get the names of the linearized outputs: - call AllocAry(InitOut%LinNames_y, p%Jac_ny,'LinNames_y',ErrStat2,ErrMsg2); if (Failed()) return - call AllocAry(InitOut%RotFrame_y, p%Jac_ny,'RotFrame_y',ErrStat2,ErrMsg2); if (Failed()) return - - - InitOut%RotFrame_y = .false. ! default all to false, then set the true ones below - indx_next = 1 - if (.not. p_AD%CompAeroMaps) then - p%Jac_y_idxStartList%NacelleLoad = indx_next; call PackLoadMesh_Names(y%NacelleLoad, 'Nacelle', InitOut%LinNames_y, indx_next) - p%Jac_y_idxStartList%HubLoad = indx_next; call PackLoadMesh_Names(y%HubLoad, 'Hub', InitOut%LinNames_y, indx_next) - p%Jac_y_idxStartList%TFinLoad = indx_next; call PackLoadMesh_Names(y%TFinLoad, 'TailFin', InitOut%LinNames_y, indx_next) - p%Jac_y_idxStartList%TowerLoad = indx_next; call PackLoadMesh_Names(y%TowerLoad, 'Tower', InitOut%LinNames_y, indx_next) ! note: y%TowerLoad%NNodes=0 for aeroMaps - endif - - indx_last = indx_next - p%Jac_y_idxStartList%BladeLoad = indx_next; - do k=1,p%NumBl_Lin - call PackLoadMesh_Names(y%BladeLoad(k), 'Blade '//trim(num2lstr(k)), InitOut%LinNames_y, indx_next) - 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 - - if (.not. p_AD%CompAeroMaps) then - ! Outputs - 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 - - ! check for all the WriteOutput values that are functions of blade number: - allocate( AllOut(0:MaxOutPts), STAT=ErrStat2 ) ! allocate starting at zero to account for invalid output channels - if (ErrStat2 /=0 ) then - ErrStat2 = ErrID_Info - ErrMsg2 = 'error allocating temporary space for AllOut' - if (Failed()) return - end if - - AllOut = .false. - do k=1,3 - AllOut( BAzimuth(k)) = .true. - AllOut( BPitch (k)) = .true. - - AllOut( BAeroFx( k)) = .true. - AllOut( BAeroFy( k)) = .true. - AllOut( BAeroFz( k)) = .true. - AllOut( BAeroMx( k)) = .true. - AllOut( BAeroMy( k)) = .true. - AllOut( BAeroMz( k)) = .true. - !AllOut( TipClrnc(k)) = .true. - - do j=1,9 - AllOut(BNVUndx(j,k)) = .true. - AllOut(BNVUndy(j,k)) = .true. - AllOut(BNVUndz(j,k)) = .true. - AllOut(BNVDisx(j,k)) = .true. - AllOut(BNVDisy(j,k)) = .true. - AllOut(BNVDisz(j,k)) = .true. - AllOut(BNSTVx (j,k)) = .true. - AllOut(BNSTVy (j,k)) = .true. - AllOut(BNSTVz (j,k)) = .true. - AllOut(BNVRel (j,k)) = .true. - AllOut(BNDynP (j,k)) = .true. - AllOut(BNRe (j,k)) = .true. - AllOut(BNM (j,k)) = .true. - AllOut(BNVIndx(j,k)) = .true. - AllOut(BNVIndy(j,k)) = .true. - AllOut(BNAxInd(j,k)) = .true. - AllOut(BNTnInd(j,k)) = .true. - AllOut(BNAlpha(j,k)) = .true. - AllOut(BNTheta(j,k)) = .true. - AllOut(BNPhi (j,k)) = .true. - AllOut(BNCurve(j,k)) = .true. - AllOut(BNCl (j,k)) = .true. - AllOut(BNCd (j,k)) = .true. - AllOut(BNCm (j,k)) = .true. - AllOut(BNCx (j,k)) = .true. - AllOut(BNCy (j,k)) = .true. - AllOut(BNCn (j,k)) = .true. - AllOut(BNCt (j,k)) = .true. - AllOut(BNFl (j,k)) = .true. - AllOut(BNFd (j,k)) = .true. - AllOut(BNMm (j,k)) = .true. - AllOut(BNFx (j,k)) = .true. - AllOut(BNFy (j,k)) = .true. - AllOut(BNFn (j,k)) = .true. - AllOut(BNFt (j,k)) = .true. - AllOut(BNClrnc(j,k)) = .true. - end do - end do - - - do i=1,p%NumOuts - 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 - - end if - - call Cleanup() - -contains - logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - if (Failed) call Cleanup() - end function Failed - - subroutine Cleanup() - if (allocated(AllOut)) deallocate(AllOut) - end subroutine Cleanup -END SUBROUTINE Init_Jacobian_y - - -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Init_Jacobian_u( InputFileData, p, p_AD, u, InitOut, ErrStat, ErrMsg) - TYPE(RotInputFile) , INTENT(IN ) :: InputFileData !< input file data (for default blade perturbation) - TYPE(RotParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(AD_ParameterType) , INTENT(INOUT) :: p_AD !< parameters - TYPE(RotInputType) , INTENT(IN ) :: u !< inputs - TYPE(RotInitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) - 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, j, k, index, indexNames, index_last, nu, i_meshField - INTEGER(IntKi) :: NumFieldsForLinearization - REAL(ReKi) :: perturb, perturb_t, perturb_b(AD_MaxBl_Out) - LOGICAL :: FieldMask(FIELDMASK_SIZE) - CHARACTER(1), PARAMETER :: UVW(3) = (/'U','V','W'/) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Init_Jacobian_u' - - ErrStat = ErrID_None - ErrMsg = "" - - p%NumExtendedInputs = 3 ! Extended inputs from InflowWind: HWindSpeed, PLexp, PropagationDir - - ! determine how many inputs there are in the Jacobians - if (p_AD%CompAeroMaps) then - nu = 0 - - NumFieldsForLinearization = 3 ! Translation Displacements + orientations + Translation velocities at each node on the blade mesh - else - nu = u%NacelleMotion%NNodes * 6 & ! 3 Translation Displacements + 3 orientations - + u%hubMotion%NNodes * 9 & ! 3 Translation Displacements + 3 orientations + 3 Rotation velocities - + u%TowerMotion%NNodes * 12 & ! 3 Translation Displacements + 3 orientations + 3 Translation velocities + 3 Translation Accelerations - + u%TFinMotion%NNodes * 9 & ! 3 Translation Displacements + 3 orientations + 3 Translation velocities - + size( u%UserProp) & ! typically number of blades - + p%NumExtendedInputs - - NumFieldsForLinearization = 6 ! Translation Displacements + orientations + Translation velocities + Rotation velocities + TranslationAcc + RotationAcc at each node on the blade mesh - do i=1,p%NumBlades - nu = nu + u%BladeRootMotion(i)%NNodes * 3 ! 3 orientations at each node - end do - end if - - do i=1,p%NumBl_Lin - nu = nu + u%BladeMotion(i)%NNodes * 3*NumFieldsForLinearization ! 3 components per additional field - end do - - ! all other inputs ignored - - - !............................ - ! fill matrix to store index to help us figure out what the ith value of the u vector really means - ! (see aerodyn::perturb_u ... these MUST match ) - ! column 1 indicates module's mesh and field - ! column 2 indicates the first index (x-y-z component) of the field - ! column 3 is the node - !............................ - - call allocAry( p%Jac_u_indx, nu, 3, 'p%Jac_u_indx', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(InitOut%LinNames_u, nu, 'LinNames_u', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(InitOut%RotFrame_u, nu, 'RotFrame_u', ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(InitOut%IsLoad_u, nu, 'IsLoad_u', ErrStat2, ErrMsg2); if (Failed()) return - - ! perturbations - call allocAry( p%du, 39, 'p%du', ErrStat2, ErrMsg2); if (Failed()) return ! number of unique values in p%Jac_u_indx(:,1) (check below) - perturb = 2*D2R - do k=1,p%NumBl_Lin - perturb_b(k) = 0.2_ReKi*D2R * InputFileData%BladeProps(k)%BlSpn( InputFileData%BladeProps(k)%NumBlNds ) +subroutine AD_VarsPackExtInput(Vars, t, p, ValAry) + use IfW_FlowField_Types, only : UniformField_Interp + use IfW_FlowField, only : UniformField_InterpCubic, UniformField_InterpLinear + type(ModVarsType), intent(in) :: Vars + real(DbKi), intent(in) :: t !< Time in seconds at operating point + type(AD_ParameterType), intent(in) :: p !< Parameters + real(R8Ki), intent(inout) :: ValAry(:) + type(UniformField_Interp) :: op !< Interpolated values of UniformField + integer(IntKi) :: i + logical :: first + first = .true. + do i = 1, size(Vars%u) + associate(Var => Vars%u(i)) + select case(Var%DL%Num) + case (AD_u_HWindSpeed) + call CalcExtOP() + ValAry(Var%iLoc(1)) = op%VelH + case (AD_u_PLExp) + call CalcExtOP() + ValAry(Var%iLoc(1)) = op%ShrV + case (AD_u_PropagationDir) + call CalcExtOP() + ValAry(Var%iLoc(1)) = op%AngleH + p%FlowField%PropagationDir + end select + end associate end do - if ( u%TowerMotion%NNodes > 0) then - perturb_t = 0.2_ReKi*D2R * u%TowerMotion%Position( 3, u%TowerMotion%NNodes ) - else - perturb_t = 0.0_ReKi - end if - - ! initialize - p%Jac_u_indx = 0 - p%du = 0.0_R8Ki - InitOut%IsLoad_u = .false. ! None of AeroDyn's inputs are loads - InitOut%RotFrame_u = .false. - - - !=========================================================================== - ! AD input mappings stored in p%Jac_u_indx, perturbations in p%du - !=========================================================================== - index = 1 - - if (.not. p_AD%CompAeroMaps) then - !------------------------------ - ! Nacelle - ! Module/Mesh/Field: u%NacelleMotion%TranslationDisp = 1; - ! Module/Mesh/Field: u%NacelleMotion%Orientation = 2; - indexNames=index - p%Jac_u_idxStartList%Nacelle = index - call SetJac_u_idx(1,2,u%NacelleMotion%NNodes,index) - ! Perturbations - p%du(1) = perturb_b(1) - p%du(2) = perturb - ! Names - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_ORIENTATION) = .true. - call PackMotionMesh_Names(u%NacelleMotion, 'Nacelle', InitOut%LinNames_u, indexNames, FieldMask=FieldMask) - - !------------------------------ - ! Hub - ! Module/Mesh/Field: u%HubMotion%TranslationDisp = 3; - ! Module/Mesh/Field: u%HubMotion%Orientation = 4; - ! Module/Mesh/Field: u%HubMotion%RotationVel = 5; - indexNames=index - p%Jac_u_idxStartList%Hub = index - call SetJac_u_idx(3,5,u%HubMotion%NNodes,index) - ! Perturbations - p%du(3) = perturb_b(1) - p%du(4) = perturb - p%du(5) = perturb - ! Names - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_ORIENTATION) = .true. - FieldMask(MASKID_ROTATIONVEL) = .true. - call PackMotionMesh_Names(u%HubMotion, 'Hub', InitOut%LinNames_u, indexNames, FieldMask=FieldMask) - - - !------------------------------ - ! TailFin - ! Module/Mesh/Field: u%TFinMotion%TranslationDisp = 6; - ! Module/Mesh/Field: u%TFinMotion%Orientation = 7; - ! Module/Mesh/Field: u%TFinMotion%TranslationVel = 8; - indexNames=index - p%Jac_u_idxStartList%TFin = index - call SetJac_u_idx(6,8,u%TFinMotion%NNodes,index) - ! Perturbations - p%du(6) = perturb - p%du(7) = perturb - p%du(8) = perturb - ! Names - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_ORIENTATION) = .true. - FieldMask(MASKID_TRANSLATIONVEL) = .true. - call PackMotionMesh_Names(u%TFinMotion, 'TailFin', InitOut%LinNames_u, indexNames, FieldMask=FieldMask) - - - !------------------------------ - ! Tower - ! Module/Mesh/Field: u%TowerMotion%TranslationDisp = 9; - ! Module/Mesh/Field: u%TowerMotion%Orientation = 10; - ! Module/Mesh/Field: u%TowerMotion%TranslationVel = 11; - ! Module/Mesh/Field: u%TowerMotion%TranslationAcc = 12; - indexNames=index - p%Jac_u_idxStartList%Tower = index - call SetJac_u_idx(9,12,u%TowerMotion%NNodes,index) - ! Perturbations - p%du( 9) = perturb_t - p%du(10) = perturb - p%du(11) = perturb_t - p%du(12) = perturb_t - ! Names - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_ORIENTATION) = .true. - FieldMask(MASKID_TRANSLATIONVEL) = .true. - FieldMask(MASKID_TRANSLATIONACC) = .true. - call PackMotionMesh_Names(u%TowerMotion, 'Tower', InitOut%LinNames_u, indexNames, FieldMask=FieldMask) - - - !------------------------------ - ! Blade root (3 blade limit!!!!) - ! Module/Mesh/Field: u%BladeRootMotion(1)%Orientation = 13; - ! Module/Mesh/Field: u%BladeRootMotion(2)%Orientation = 14; - ! Module/Mesh/Field: u%BladeRootMotion(3)%Orientation = 15; - indexNames=index - p%Jac_u_idxStartList%BladeRoot = index - do k = 1,p%NumBl_Lin - call SetJac_u_idx(13+k-1,13+k-1,u%BladeRootMotion(k)%NNodes,index) - end do - ! Perturbations - p%du(13) = perturb - p%du(14) = perturb - p%du(15) = perturb - ! Names - FieldMask = .false. - FieldMask(MASKID_Orientation) = .true. - do k = 1,p%NumBl_Lin - call PackMotionMesh_Names(u%BladeRootMotion(k), 'Blade root '//trim(num2lstr(k)), InitOut%LinNames_u, indexNames, FieldMask=FieldMask) - end do - end if ! .not. compAeroMaps - - - !------------------------------ - ! Blades (3 blade limit!!!!!) - ! Module/Mesh/Field: u%BladeMotion(1)%TranslationDisp = 16 + (bladenum-1)*6; - ! Module/Mesh/Field: u%BladeMotion(1)%Orientation = 17 + (bladenum-1)*6; - ! Module/Mesh/Field: u%BladeMotion(1)%TranslationVel = 18 + (bladenum-1)*6; - ! Module/Mesh/Field: u%BladeMotion(1)%RotationVel = 19 + (bladenum-1)*6; full lin only - ! Module/Mesh/Field: u%BladeMotion(1)%TranslationAcc = 20 + (bladenum-1)*6; full lin only - ! Module/Mesh/Field: u%BladeMotion(1)%RotationalAcc = 21 + (bladenum-1)*6; full lin only - if (.not. p_AD%CompAeroMaps) then ! full linearization - indexNames=index - p%Jac_u_idxStartList%Blade = index - call SetJac_u_idx(16,21,u%BladeMotion(1)%NNodes,index) - if (p%NumBl_Lin > 1) call SetJac_u_idx(22,27,u%BladeMotion(2)%NNodes,index) - if (p%NumBl_Lin > 2) call SetJac_u_idx(28,33,u%BladeMotion(3)%NNodes,index) - ! Perturbations - do k=1,p%NumBl_Lin - p%du(16 + (k-1)*6) = perturb_b(k) - p%du(17 + (k-1)*6) = perturb - p%du(18 + (k-1)*6) = perturb_b(k) - p%du(19 + (k-1)*6) = perturb - p%du(20 + (k-1)*6) = perturb_b(k) - p%du(21 + (k-1)*6) = perturb - end do - ! Names - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_ORIENTATION) = .true. - FieldMask(MASKID_TRANSLATIONVEL) = .true. - FieldMask(MASKID_ROTATIONVEL) = .true. - FieldMask(MASKID_TRANSLATIONACC) = .true. - FieldMask(MASKID_ROTATIONACC) = .true. - do k=1,p%NumBl_Lin - call PackMotionMesh_Names(u%BladeMotion(k), 'Blade '//trim(num2lstr(k)), InitOut%LinNames_u, indexNames, FieldMask=FieldMask) - end do - else - indexNames=index - p%Jac_u_idxStartList%Blade = index - call SetJac_u_idx(16,18,u%BladeMotion(1)%NNodes,index) - if (p%NumBl_Lin > 1) call SetJac_u_idx(22,24,u%BladeMotion(2)%NNodes,index) - if (p%NumBl_Lin > 2) call SetJac_u_idx(28,30,u%BladeMotion(3)%NNodes,index) - ! Perturbations - do k=1,p%NumBl_Lin - p%du(16 + (k-1)*6) = perturb_b(k) - p%du(17 + (k-1)*6) = perturb - p%du(18 + (k-1)*6) = perturb_b(k) - end do - ! Names - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_ORIENTATION) = .true. - FieldMask(MASKID_TRANSLATIONVEL) = .true. - do k=1,p%NumBl_Lin - call PackMotionMesh_Names(u%BladeMotion(k), 'Blade '//trim(num2lstr(k)), InitOut%LinNames_u, indexNames, FieldMask=FieldMask) - end do - endif - - - if (.not. p_AD%CompAeroMaps) then - !------------------------------ - ! UserProp - ! Module/Mesh/Field: u%UserProp(:,:) = 34,35,36; - p%Jac_u_idxStartList%UserProp = index - do k=1,size(u%UserProp,2) ! p%NumBlades - do i=1,size(u%UserProp,1) ! numNodes - p%Jac_u_indx(index,1) = 34 + k-1 - p%Jac_u_indx(index,2) = 1 !component index: this is a scalar, so 1, but is never used - p%Jac_u_indx(index,3) = i !Node: i - ! Names - InitOut%LinNames_u(index) = 'User property on blade '//trim(num2lstr(k))//', node '//trim(num2lstr(i))//', -' - ! RotFrame - InitOut%RotFrame_u(index) = .true. - index = index + 1 - end do !i - ! Perturbations - p%du(34 + k-1) = perturb - end do ! - - - !------------------------------ - ! Extended inputs (number of these must be exactly p%NumExtendedInputs) - ! Module/Mesh/Field: HWindSpeed = 37 - ! Module/Mesh/Field: PLexp = 38 - ! Module/Mesh/Field: PropagationDir = 39 - p%Jac_u_idxStartList%Extended = index - p%Jac_u_indx(index,1)=37; p%Jac_u_indx(index,2)=1; p%Jac_u_indx(index,3)=1; InitOut%LinNames_u(index) = 'Extended input: horizontal wind speed (steady/uniform wind), m/s'; index=index+1 - p%Jac_u_indx(index,1)=38; p%Jac_u_indx(index,2)=1; p%Jac_u_indx(index,3)=1; InitOut%LinNames_u(index) = 'Extended input: vertical power-law shear exponent, -'; index=index+1 - p%Jac_u_indx(index,1)=39; p%Jac_u_indx(index,2)=1; p%Jac_u_indx(index,3)=1; InitOut%LinNames_u(index) = 'Extended input: propagation direction, rad'; index=index+1 - ! Perturbations - p%du(37) = perturb - p%du(38) = perturb - p%du(39) = perturb - - end if ! .not. compAeroMaps - -contains - subroutine SetJac_u_idx(FieldIdxStart,FieldIdxEnd,nNodes,idx) - integer, intent(in ) :: FieldIdxStart - integer, intent(in ) :: FieldIdxEnd - integer, intent(in ) :: nNodes - integer, intent(inout) :: idx - integer :: i_meshField,i,j - do i_meshField = FieldIdxStart,FieldIdxEnd - do i=1,nNodes - do j=1,3 - p%Jac_u_indx(idx,1) = i_meshField - p%Jac_u_indx(idx,2) = j !component index: j - p%Jac_u_indx(idx,3) = i !Node: i - idx = idx + 1 - end do !j - end do !i - end do - end subroutine - - logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - !if (Failed) call Cleanup() - end function Failed -END SUBROUTINE Init_Jacobian_u - - -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Init_Jacobian_x( p, InitOut, ErrStat, ErrMsg) - TYPE(RotParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(RotInitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Init_Jacobian_x' - - ! local variables: - INTEGER(IntKi) :: i, j, k, n, state - INTEGER(IntKi) :: nx - INTEGER(IntKi) :: nx1 - CHARACTER(25) :: NodeTxt - - ErrStat = ErrID_None - ErrMsg = "" - - - nx = p%BEMT%DBEMT%lin_nx + p%BEMT%UA%lin_nx + p%BEMT%lin_nx - - ! allocate space for the row/column names and for perturbation sizes - ! always allocate this in case it is size zero ... (we use size(p%dx) for many calculations) - CALL AllocAry(p%dx, nx, 'p%dx', ErrStat2, ErrMsg2); if (Failed()) return - if (nx==0) return - - CALL AllocAry(InitOut%LinNames_x, nx, 'LinNames_x', ErrStat2, ErrMsg2); if (Failed()) return - CALL AllocAry(InitOut%RotFrame_x, nx, 'RotFrame_x', ErrStat2, ErrMsg2); if (Failed()) return - CALL AllocAry(InitOut%DerivOrder_x, nx, 'DerivOrder_x', ErrStat2, ErrMsg2); if (Failed()) return - - ! All DBEMT continuous states are order = 2; UA states are order 1 - - ! set default perturbation sizes: p%dx - p%dx = 2.0_R8Ki * D2R_D - - ! set linearization output names: - nx1 = p%BEMT%DBEMT%lin_nx/2 - if (nx1>0) then - InitOut%DerivOrder_x(1:p%BEMT%DBEMT%lin_nx) = 2 - InitOut%RotFrame_x( 1:p%BEMT%DBEMT%lin_nx) = .true. - - k = 1 - do j=1,p%NumBlades ! size(x%BEMT%DBEMT%element,2) - do i=1,p%NumBlNds ! size(x%BEMT%DBEMT%element,1) - NodeTxt = 'blade '//trim(num2lstr(j))//', node '//trim(num2lstr(i)) - InitOut%LinNames_x(k) = 'vind (axial) at '//trim(NodeTxt)//', m/s' - k = k + 1 - - InitOut%LinNames_x(k) = 'vind (tangential) at '//trim(NodeTxt)//', m/s' - k = k + 1 - end do - end do - - do i=1,nx1 - InitOut%LinNames_x(i+nx1) = 'First time derivative of '//trim(InitOut%LinNames_x(i))//'/s' - InitOut%RotFrame_x(i+nx1) = InitOut%RotFrame_x(i) - end do - end if - - ! UA states - if (p%BEMT%UA%lin_nx>0) then - InitOut%DerivOrder_x(1+p%BEMT%DBEMT%lin_nx:nx) = 1 - InitOut%RotFrame_x( 1+p%BEMT%DBEMT%lin_nx:nx) = .true. - - k = 1 + p%BEMT%DBEMT%lin_nx - do n=1,p%BEMT%UA%lin_nx - i = p%BEMT%UA%lin_xIndx(n,1) - j = p%BEMT%UA%lin_xIndx(n,2) - state = p%BEMT%UA%lin_xIndx(n,3) - - p%dx(k) = p%BEMT%UA%dx(state) - - NodeTxt = 'x'//trim(num2lstr(state))//' blade '//trim(num2lstr(j))//', node '//trim(num2lstr(i)) - if (state<3) then - InitOut%LinNames_x(k) = trim(NodeTxt)//', rad' ! x1 and x2 are radians +contains + subroutine CalcExtOP() + if (.not. first) return + first = .false. + if (p%FlowField%FieldType == Uniform_FieldType) then + if (P%FlowField%VelInterpCubic) then + op = UniformField_InterpCubic(p%FlowField%Uniform, t) else - InitOut%LinNames_x(k) = trim(NodeTxt)//', -' ! x3, x4 (and x5) are units of cl or cn + op = UniformField_InterpLinear(p%FlowField%Uniform, t) end if - InitOut%DerivOrder_x(k) = 1 - InitOut%RotFrame_x(k) = .true. - - k = k + 1 - end do - end if - - ! BEMT states - if (p%BEMT%lin_nx>0) then - call SetErrStat(ErrID_Fatal,'Number of lin states for bem should be zero for now.', ErrStat, ErrMsg, RoutineName) - return - !k = 1 + p%BEMT%DBEMT%lin_nx + p%BEMT%UA%lin_nx - - !InitOut%DerivOrder_x(k:nx) = 1 - !InitOut%RotFrame_x( k:nx) = .false. - ! - !InitOut%LinNames_x(k ) = 'X-component of wake velocity, m/s' - !InitOut%LinNames_x(k+1) = 'Y-component of wake velocity, m/s' - !InitOut%LinNames_x(k+2) = 'Z-component of wake velocity, m/s' - end if -contains - logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - !if (Failed) call Cleanup() - end function Failed -END SUBROUTINE Init_Jacobian_x - - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the array that maps rows/columns of the Jacobian to specific mesh fields. -!! Do not change the order of this packing without changing corresponding parts of AD linearization ! -SUBROUTINE Init_Jacobian( InputFileData, p, p_AD, u, y, m, InitOut, ErrStat, ErrMsg) - type(RotInputFile) , intent(in ) :: InputFileData !< input file data (for default blade perturbation) - TYPE(RotParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(AD_ParameterType) , INTENT(INOUT) :: p_AD !< parameters - TYPE(RotInputType) , INTENT(IN ) :: u !< inputs - TYPE(RotOutputType) , INTENT(IN ) :: y !< outputs - TYPE(RotMiscVarType) , INTENT(IN ) :: m !< miscellaneous variable - TYPE(RotInitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) - 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 = 'Init_Jacobian' - - - ErrStat = ErrID_None - ErrMsg = "" - - if (p_AD%CompAeroMaps) then - p%NumBl_Lin = 1 - else - p%NumBl_Lin = p%NumBlades - end if - - call Init_Jacobian_y( p, p_AD, y, InitOut, ErrStat, ErrMsg) - - ! these matrices will be needed for linearization with frozen wake feature - if ( p%DBEMT_Mod == DBEMT_frozen ) then - call AllocAry(m%BEMT%AxInd_op,p%NumBlNds,p%numBlades,'m%BEMT%AxInd_op', ErrStat2,ErrMsg2); if (Failed()) return - call AllocAry(m%BEMT%TnInd_op,p%NumBlNds,p%numBlades,'m%BEMT%TnInd_op', ErrStat2,ErrMsg2); if (Failed()) return - end if - - call Init_Jacobian_u( InputFileData, p, p_AD, u, InitOut, ErrStat2, ErrMsg2); if (Failed()) return - - call Init_Jacobian_x( p, InitOut, ErrStat2, ErrMsg2); if (Failed()) return - -contains - logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - !if (Failed) call Cleanup() - end function Failed -END SUBROUTINE Init_Jacobian - - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine aerodyn::init_jacobian is consistant with this routine! -SUBROUTINE Perturb_u( p, n, perturb_sign, u, du ) - TYPE(RotParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(RotInputType) , INTENT(INOUT) :: u !< perturbed AD inputs - REAL( R8Ki ) , INTENT( OUT) :: du !< amount that specific input was perturbed - - ! local variables - INTEGER :: fieldIndx - INTEGER :: node - - fieldIndx = p%Jac_u_indx(n,2) - node = p%Jac_u_indx(n,3) - du = p%du( p%Jac_u_indx(n,1) ) - - ! determine which mesh we're trying to perturb and perturb the input: - SELECT CASE( p%Jac_u_indx(n,1) ) - - ! Nacelle - ! Module/Mesh/Field: u%NacelleMotion%TranslationDisp = 1; - ! Module/Mesh/Field: u%NacelleMotion%Orientation = 2; - case( 1); u%NacelleMotion%TranslationDisp(fieldIndx,node) = u%NacelleMotion%TranslationDisp(fieldIndx,node) + du * perturb_sign - case( 2); call PerturbOrientationMatrix( u%NacelleMotion%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - - ! Hub - ! Module/Mesh/Field: u%HubMotion%TranslationDisp = 3; - ! Module/Mesh/Field: u%HubMotion%Orientation = 4; - ! Module/Mesh/Field: u%HubMotion%RotationVel = 5; - case( 3); u%HubMotion%TranslationDisp(fieldIndx,node) = u%HubMotion%TranslationDisp(fieldIndx,node) + du * perturb_sign - case( 4); call PerturbOrientationMatrix( u%HubMotion%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - case( 5); u%HubMotion%RotationVel( fieldIndx,node) = u%HubMotion%RotationVel(fieldIndx,node) + du * perturb_sign - - ! TailFin - ! Module/Mesh/Field: u%TFinMotion%TranslationDisp = 6; - ! Module/Mesh/Field: u%TFinMotion%Orientation = 7; - ! Module/Mesh/Field: u%TFinMotion%TranslationVel = 8; - case( 6); u%TFinMotion%TranslationDisp(fieldIndx,node) = u%TFinMotion%TranslationDisp(fieldIndx,node) + du * perturb_sign - case( 7); call PerturbOrientationMatrix( u%TFinMotion%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - case( 8); u%TFinMotion%TranslationVel( fieldIndx,node) = u%TFinMotion%TranslationVel(fieldIndx,node) + du * perturb_sign - - ! Tower - ! Module/Mesh/Field: u%TowerMotion%TranslationDisp = 9; - ! Module/Mesh/Field: u%TowerMotion%Orientation = 10; - ! Module/Mesh/Field: u%TowerMotion%TranslationVel = 11; - ! Module/Mesh/Field: u%TowerMotion%TranslationAcc = 12; - case( 9); u%TowerMotion%TranslationDisp(fieldIndx,node) = u%TowerMotion%TranslationDisp( fieldIndx,node) + du * perturb_sign - case(10); CALL PerturbOrientationMatrix( u%TowerMotion%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.false. ) - case(11); u%TowerMotion%TranslationVel( fieldIndx,node) = u%TowerMotion%TranslationVel( fieldIndx,node) + du * perturb_sign - case(12); u%TowerMotion%TranslationAcc( fieldIndx,node) = u%TowerMotion%TranslationAcc(fieldIndx,node) + du * perturb_sign - - ! BladeRoot - ! Module/Mesh/Field: u%BladeRootMotion(1)%Orientation = 13; - ! Module/Mesh/Field: u%BladeRootMotion(2)%Orientation = 14; - ! Module/Mesh/Field: u%BladeRootMotion(3)%Orientation = 15; - case(13); call PerturbOrientationMatrix( u%BladeRootMotion(1)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - case(14); call PerturbOrientationMatrix( u%BladeRootMotion(2)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - case(15); call PerturbOrientationMatrix( u%BladeRootMotion(3)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - - ! Blade 1 - ! Module/Mesh/Field: u%BladeMotion(1)%TranslationDisp = 16; - ! Module/Mesh/Field: u%BladeMotion(1)%Orientation = 17; - ! Module/Mesh/Field: u%BladeMotion(1)%TranslationVel = 18; - ! Module/Mesh/Field: u%BladeMotion(1)%RotationVel = 19; - ! Module/Mesh/Field: u%BladeMotion(1)%TranslationAcc = 20; - ! Module/Mesh/Field: u%BladeMotion(1)%RotationalAcc = 21; - case(16); u%BladeMotion(1)%TranslationDisp(fieldIndx,node) = u%BladeMotion(1)%TranslationDisp(fieldIndx,node) + du * perturb_sign - case(17); call PerturbOrientationMatrix( u%BladeMotion(1)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - case(18); u%BladeMotion(1)%TranslationVel( fieldIndx,node) = u%BladeMotion(1)%TranslationVel(fieldIndx,node) + du * perturb_sign - case(19); u%BladeMotion(1)%RotationVel( fieldIndx,node) = u%BladeMotion(1)%RotationVel( fieldIndx,node) + du * perturb_sign - case(20); u%BladeMotion(1)%TranslationAcc( fieldIndx,node) = u%BladeMotion(1)%TranslationAcc(fieldIndx,node) + du * perturb_sign - case(21); u%BladeMotion(1)%RotationAcc( fieldIndx,node) = u%BladeMotion(1)%RotationAcc( fieldIndx,node) + du * perturb_sign - - ! Blade 2 - ! Module/Mesh/Field: u%BladeMotion(2)%TranslationDisp = 22; - ! Module/Mesh/Field: u%BladeMotion(2)%Orientation = 23; - ! Module/Mesh/Field: u%BladeMotion(2)%TranslationVel = 24; - ! Module/Mesh/Field: u%BladeMotion(2)%RotationVel = 25; - ! Module/Mesh/Field: u%BladeMotion(2)%TranslationAcc = 26; - ! Module/Mesh/Field: u%BladeMotion(2)%RotationalAcc = 27; - case(22); u%BladeMotion(2)%TranslationDisp(fieldIndx,node) = u%BladeMotion(2)%TranslationDisp(fieldIndx,node) + du * perturb_sign - case(23); call PerturbOrientationMatrix( u%BladeMotion(2)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - case(24); u%BladeMotion(2)%TranslationVel( fieldIndx,node) = u%BladeMotion(2)%TranslationVel(fieldIndx,node) + du * perturb_sign - case(25); u%BladeMotion(2)%RotationVel( fieldIndx,node) = u%BladeMotion(2)%RotationVel( fieldIndx,node) + du * perturb_sign - case(26); u%BladeMotion(2)%TranslationAcc( fieldIndx,node) = u%BladeMotion(2)%TranslationAcc(fieldIndx,node) + du * perturb_sign - case(27); u%BladeMotion(2)%RotationAcc( fieldIndx,node) = u%BladeMotion(2)%RotationAcc( fieldIndx,node) + du * perturb_sign - - ! Blade 3 - ! Module/Mesh/Field: u%BladeMotion(3)%TranslationDisp = 28; - ! Module/Mesh/Field: u%BladeMotion(3)%Orientation = 29; - ! Module/Mesh/Field: u%BladeMotion(3)%TranslationVel = 30; - ! Module/Mesh/Field: u%BladeMotion(3)%RotationVel = 31; - ! Module/Mesh/Field: u%BladeMotion(3)%TranslationAcc = 32; - ! Module/Mesh/Field: u%BladeMotion(3)%RotationalAcc = 33; - case(28); u%BladeMotion(3)%TranslationDisp(fieldIndx,node) = u%BladeMotion(3)%TranslationDisp(fieldIndx,node) + du * perturb_sign - case(29); call PerturbOrientationMatrix( u%BladeMotion(3)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - case(30); u%BladeMotion(3)%TranslationVel( fieldIndx,node) = u%BladeMotion(3)%TranslationVel(fieldIndx,node) + du * perturb_sign - case(31); u%BladeMotion(3)%RotationVel( fieldIndx,node) = u%BladeMotion(3)%RotationVel( fieldIndx,node) + du * perturb_sign - case(32); u%BladeMotion(3)%TranslationAcc( fieldIndx,node) = u%BladeMotion(3)%TranslationAcc(fieldIndx,node) + du * perturb_sign - case(33); u%BladeMotion(3)%RotationAcc( fieldIndx,node) = u%BladeMotion(3)%RotationAcc( fieldIndx,node) + du * perturb_sign - - ! UserProp - ! Module/Mesh/Field: u%UserProp(:,:) = 34,35,36; - case(34); u%UserProp(node,1) = u%UserProp(node,1) + du * perturb_sign - case(35); u%UserProp(node,2) = u%UserProp(node,2) + du * perturb_sign - case(36); u%UserProp(node,3) = u%UserProp(node,3) + du * perturb_sign - - END SELECT - -END SUBROUTINE Perturb_u - - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the u array extended inputs (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine aerodyn::init_jacobian is consistant with this routine! -subroutine Perturb_uExtend( t, u_perturb, FlowField_perturb, RotInflow_perturb, p, OtherState, n, perturb_sign, u, du, ErrStat, ErrMsg ) - real(DbKi), intent(in ) :: t !< Time in seconds at operating point - type(RotInputType), intent(inout) :: u_perturb - type(FLowFieldType),pointer, intent(inout) :: FlowField_perturb !< perturbed flowfield (only the uniform wind) - type(RotInflowType), intent(inout) :: RotInflow_perturb !< Rotor inflow, perturbed by FlowField extended inputs - type(RotParameterType), intent(in ) :: p !< parameters - type(RotOtherStateType), intent(in ) :: OtherState !< Other states at operating point - integer( IntKi ), intent(in ) :: n !< number of array element to use - integer( IntKi ), intent(in ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - type(RotInputType), intent(inout) :: u !< perturbed AD inputs - real( R8Ki ), intent( out) :: du !< amount that specific input was perturbed - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - integer :: fieldIndx - integer :: node - real(R8Ki) :: FlowField_du(3) !< vector of perturbations to apply to flow field - integer(intKi) :: StartNode - - ! Error handling - ErrStat = ErrID_None - ErrMsg = "" - - fieldIndx = p%Jac_u_indx(n,2) - node = p%Jac_u_indx(n,3) - du = p%du( p%Jac_u_indx(n,1) ) - StartNode = 1 ! ignored during linearization since cannot linearize with ExtInflow - - ! determine which mesh we're trying to perturb and perturb the input: - select case( p%Jac_u_indx(n,1) ) - ! Extended inputs - ! Module/Mesh/Field: HWindSpeed = 37 - ! Module/Mesh/Field: PLexp = 38 - ! Module/Mesh/Field: PropagationDir = 39 - case(37,38,39) - FlowField_du = 0.0_R8Ki - select case( p%Jac_u_indx(n,1) ) - case (37); FlowField_du(1) = du *perturb_sign - case (38); FlowField_du(2) = du *perturb_sign - case (39); FlowField_du(3) = du *perturb_sign - end select - call IfW_UniformWind_Perturb(FlowField_perturb, FlowField_du) - end select - call AD_CalcWind_Rotor(t, u_perturb, FlowField_perturb, p, RotInflow_perturb, StartNode, ErrStat, ErrMsg) -end subroutine Perturb_uExtend - - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine aerodyn::init_jacobian is consistant with this routine! -SUBROUTINE Perturb_x( p, n, perturb_sign, x, dx ) - TYPE(RotParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(RotContinuousStateType) , INTENT(INOUT) :: x !< perturbed AD continuous states - REAL( R8Ki ) , INTENT( OUT) :: dx !< amount that specific input was perturbed - - ! local variables - INTEGER(IntKi) :: Blade ! loop over blade nodes - INTEGER(IntKi) :: BladeNode ! loop over blades - INTEGER(IntKi) :: StateIndex ! which state we are perturbing - INTEGER(IntKi) :: n_tmp ! - - - dx = p%dx( n ) - - if (n <= p%BEMT%DBEMT%lin_nx) then - - if (n <= p%BEMT%DBEMT%lin_nx/2) then ! x_p%BEMT%DBEMT%element(i,j)%vind, else x_p%BEMT%DBEMT%element(i,j)%vind_1 - call GetStateIndices( n, size(x%BEMT%DBEMT%element,2), size(x%BEMT%DBEMT%element,1), size(x%BEMT%DBEMT%element(1,1)%vind), Blade, BladeNode, StateIndex ) - x%BEMT%DBEMT%element(BladeNode,Blade)%vind(StateIndex) = x%BEMT%DBEMT%element(BladeNode,Blade)%vind(StateIndex) + dx * perturb_sign - else - call GetStateIndices( n - p%BEMT%DBEMT%lin_nx/2, size(x%BEMT%DBEMT%element,2), size(x%BEMT%DBEMT%element,1), size(x%BEMT%DBEMT%element(1,1)%vind_1), Blade, BladeNode, StateIndex ) - x%BEMT%DBEMT%element(BladeNode,Blade)%vind_1(StateIndex) = x%BEMT%DBEMT%element(BladeNode,Blade)%vind_1(StateIndex) + dx * perturb_sign - endif - - else - - n_tmp = n - p%BEMT%DBEMT%lin_nx - - if (n_tmp <= p%BEMT%UA%lin_nx) then - BladeNode = p%BEMT%UA%lin_xIndx(n_tmp,1) ! node - Blade = p%BEMT%UA%lin_xIndx(n_tmp,2) ! blade - StateIndex = p%BEMT%UA%lin_xIndx(n_tmp,3) ! state - - x%BEMT%UA%element(BladeNode,Blade)%x(StateIndex) = x%BEMT%UA%element(BladeNode,Blade)%x(StateIndex) + dx * perturb_sign else - StateIndex = n_tmp - p%BEMT%UA%lin_nx - x%BEMT%V_w(StateIndex) = x%BEMT%V_w(StateIndex) + dx * perturb_sign + op%VelH = 0.0_ReKi + op%ShrV = 0.0_ReKi + op%AngleH = 0.0_ReKi end if - end if - -contains - subroutine GetStateIndices( Indx, NumberOfBlades, NumberOfElementsPerBlade, NumberOfStatesPerElement, Blade, BladeNode, StateIndex ) - - integer(IntKi), intent(in ) :: Indx - integer(IntKi), intent(in ) :: NumberOfBlades !< how many blades (size of array) - integer(IntKi), intent(in ) :: NumberOfElementsPerBlade !< how many nodes per blades (size of array) - integer(IntKi), intent(in ) :: NumberOfStatesPerElement !< how many states at each blade element - - integer(IntKi), intent( out) :: Blade - integer(IntKi), intent( out) :: BladeNode - integer(IntKi), intent( out) :: StateIndex - - integer(IntKi) :: CheckNum - - - StateIndex = mod(Indx-1, NumberOfStatesPerElement ) + 1 ! returns a number in [1,NumberOfStatesPerElement] - - CheckNum = (Indx - StateIndex)/NumberOfStatesPerElement - BladeNode = mod(CheckNum, NumberOfElementsPerBlade ) + 1 ! returns a number in [1,NumberOfElementsPerBlade] - - Blade = (CheckNum - BladeNode + 1)/NumberOfElementsPerBlade + 1 - - end subroutine GetStateIndices -END SUBROUTINE Perturb_x - + end subroutine +end subroutine !---------------------------------------------------------------------------------------------------------------------------------- !> This routine uses values of two output types to compute an array of differences. @@ -7661,7 +7048,6 @@ SUBROUTINE Compute_dY(p, p_AD, y_p, y_m, delta_p, delta_m, dY) END SUBROUTINE Compute_dY - !---------------------------------------------------------------------------------------------------------------------------------- !> This routine uses values of two continuous state types to compute an array of differences. !! Do not change this packing without making sure subroutine aerodyn::init_jacobian is consistant with this routine! @@ -7725,7 +7111,7 @@ END SUBROUTINE Compute_dX !------------------------------------------------------------------------------------------------------- !> This routine calculates nacelle drag loads on a turbine. -SUBROUTINE computeNacelleDrag( u, p, m, y, RotInflow, ErrStat, ErrMsg ) +SUBROUTINE RotCalcNacelleDrag( u, p, m, y, RotInflow, ErrStat, ErrMsg ) TYPE(RotInputType) , INTENT(IN ) :: u !< AD inputs - used for mesh node positions TYPE(RotParameterType) , INTENT(IN ) :: p !< Parameters @@ -7800,7 +7186,7 @@ SUBROUTINE computeNacelleDrag( u, p, m, y, RotInflow, ErrStat, ErrMsg ) -END SUBROUTINE computeNacelleDrag +END SUBROUTINE RotCalcNacelleDrag !---------------------------------------------------------------------------------------------------------------------------------- END MODULE AeroDyn diff --git a/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 index 1a9e9bca75..8ee2c56997 100644 --- a/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 @@ -1526,7 +1526,7 @@ SUBROUTINE BldNdOuts_SetOutParam(BldNd_OutList, p, p_AD, ErrStat, ErrMsg ) ! ..... Developer must add checking for invalid inputs here: ..... - if (.not. p%Buoyancy) then + if ( p%MHK == 0 ) then InvalidOutput( BldNd_Fbxi ) = .true. InvalidOutput( BldNd_Fbyi ) = .true. InvalidOutput( BldNd_Fbzi ) = .true. diff --git a/modules/aerodyn/src/AeroDyn_Driver.f90 b/modules/aerodyn/src/AeroDyn_Driver.f90 index 076f0a4bcc..66b7aa7ab2 100644 --- a/modules/aerodyn/src/AeroDyn_Driver.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver.f90 @@ -41,12 +41,12 @@ program AeroDyn_Driver ! ----- dat%initialized=.false. - call Dvr_Init(dat%dvr, dat%ADI, dat%FED, dat%errStat, dat%errMsg); call CheckError() + call Dvr_Init(dat%dvr, dat%ADI, dat%FED, dat%SeaSt, dat%errStat, dat%errMsg); call CheckError() do iCase= 1,dat%dvr%numCases ! Initial case - call Dvr_InitCase(iCase, dat%dvr, dat%ADI, dat%FED, dat%errStat, dat%errMsg); call CheckError() + call Dvr_InitCase(iCase, dat%dvr, dat%ADI, dat%FED, dat%SeaSt, dat%errStat, dat%errMsg); call CheckError() dat%initialized=.true. ! Init of time estimator @@ -58,7 +58,7 @@ program AeroDyn_Driver ! One time loop do nt = 1, dat%dvr%numSteps - call Dvr_TimeStep(nt, dat%dvr, dat%ADI, dat%FED, dat%errStat, dat%errMsg); call CheckError() + call Dvr_TimeStep(nt, dat%dvr, dat%ADI, dat%FED, dat%SeaSt, dat%errStat, dat%errMsg); call CheckError() ! Time update to screen t_global=nt*dat%dvr%dt !if (dat%dvr%analysisType/=idAnalysisCombi) then diff --git a/modules/aerodyn/src/AeroDyn_Driver_Registry.txt b/modules/aerodyn/src/AeroDyn_Driver_Registry.txt index 47c55804f2..64ea7e4a2a 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Driver_Registry.txt @@ -13,6 +13,7 @@ include Registry_NWTC_Library.txt usefrom AeroDyn_Registry.txt usefrom AeroDyn_Inflow_Registry.txt +usefrom SeaState.txt # # ..... Table of combined cases to run ....................................................................................................... typedef AeroDyn_Driver/AD_Dvr Dvr_Case ReKi HWindSpeed - - - "Hub wind speed" "m/s" @@ -152,13 +153,14 @@ typedef ^ ^ IntKi iTimeSe typedef ^ ^ character(1024) root - - - "Output file rootname" "-" typedef ^ ^ Dvr_Outputs out - - - "data for driver output file" "-" typedef ^ ^ ADI_IW_InputData IW_InitInp - - - "" - +typedef ^ ^ SeaSt_InitInputType SS_InitInp - - - "" - # ..... Data to wrap the driver .......................................................................................................... -typedef ^ AllData Dvr_SimData dvr - - - "Driver data" - -typedef ^ ^ ADI_Data ADI - - - "AeroDyn InflowWind Data" - -typedef ^ ^ FED_Data FED - - - "Elastic wind turbine data (Fake ElastoDyn)" "-" -typedef ^ ^ IntKi errStat - - - "" - -typedef ^ ^ character(ErrMsgLen) errMsg - - - "" - -typedef ^ ^ logical initialized - - - "" - - +typedef ^ AllData Dvr_SimData dvr - - - "Driver data" - +typedef ^ ^ ADI_Data ADI - - - "AeroDyn InflowWind Data" - +typedef ^ ^ FED_Data FED - - - "Elastic wind turbine data (Fake ElastoDyn)" "-" +typedef ^ ^ IntKi errStat - - - "" - +typedef ^ ^ character(ErrMsgLen) errMsg - - - "" - +typedef ^ ^ logical initialized - - - "" - +typedef ^ ^ SeaState_Data SeaSt - - - "SeaState data" - diff --git a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 index d609215127..1591a59541 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 @@ -24,6 +24,7 @@ module AeroDyn_Driver_Subs use AeroDyn_Inflow, only: concatOutputHeaders use AeroDyn_Inflow, only: Init_MeshMap_For_ADI, Set_Inputs_For_ADI use AeroDyn_IO, only: AD_WrVTK_Surfaces, AD_WrVTK_LinesPoints + use SeaState, only: SeaSt_Init, SeaSt_CalcOutput use AeroDyn_Driver_Types use AeroDyn @@ -90,10 +91,11 @@ module AeroDyn_Driver_Subs !---------------------------------------------------------------------------------------------------------------------------------- !> -subroutine Dvr_Init(dvr, ADI, FED, errStat, errMsg ) +subroutine Dvr_Init(dvr, ADI, FED, SeaSt, errStat, errMsg ) type(Dvr_SimData), intent( out) :: dvr !< driver data type(ADI_Data), intent( out) :: ADI !< AeroDyn/InflowWind data type(FED_Data), intent( out) :: FED !< Elastic wind turbine data (Fake ElastoDyn) + type(SeaState_Data), intent( out) :: SeaSt !< SeaState data integer(IntKi) , intent( out) :: errStat !< Status of error message character(*) , intent( out) :: errMsg !< Error message if errStat /= ErrID_None ! local variables @@ -139,13 +141,15 @@ end subroutine Dvr_Init !---------------------------------------------------------------------------------------------------------------------------------- !> -subroutine Dvr_InitCase(iCase, dvr, ADI, FED, errStat, errMsg ) - integer(IntKi) , intent(in ) :: iCase - type(Dvr_SimData), intent(inout) :: dvr !< driver data - type(ADI_Data), intent(inout) :: ADI !< AeroDyn/InflowWind data - type(FED_Data), intent(inout) :: FED !< Elastic wind turbine data (Fake ElastoDyn) - integer(IntKi) , intent( out) :: errStat ! Status of error message - character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None +subroutine Dvr_InitCase(iCase, dvr, ADI, FED, SeaSt, errStat, errMsg ) + integer(IntKi) , intent(in ) :: iCase + type(Dvr_SimData) , intent(inout) :: dvr !< driver data + type(ADI_Data) , intent(inout) :: ADI !< AeroDyn/InflowWind data + type(FED_Data) , intent(inout) :: FED !< Elastic wind turbine data (Fake ElastoDyn) + type(SeaState_Data) , intent(inout) :: SeaSt !< SeaState data + integer(IntKi) , intent( out) :: errStat ! Status of error message + character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None + ! local variables integer(IntKi) :: errStat2 ! local status of error message character(ErrMsgLen) :: errMsg2 ! local error message if errStat /= ErrID_None @@ -241,6 +245,45 @@ subroutine Dvr_InitCase(iCase, dvr, ADI, FED, errStat, errMsg ) ! --- AeroDyn + Inflow at T=0 call ADI_CalcOutput(ADI%inputTimes(1), ADI%u(1), ADI%p, ADI%x(1), ADI%xd(1), ADI%z(1), ADI%OtherState(1), ADI%y, ADI%m, errStat2, errMsg2); if(Failed()) return + ! --- Initialize SeaState + if ( dvr%SS_InitInp%CompSeaSt == 1 ) then + + SeaSt%InitInp%Gravity = 9.80665_ReKi + SeaSt%InitInp%hasIce = .FALSE. + SeaSt%InitInp%defWtrDens = dvr%FldDens + SeaSt%InitInp%defWtrDpth = dvr%WtrDpth + SeaSt%InitInp%defMSL2SWL = dvr%MSL2SWL + SeaSt%InitInp%MHK = dvr%MHK + SeaSt%InitInp%UseInputFile = .TRUE. + SeaSt%InitInp%Linearize = .FALSE. + SeaSt%InitInp%InputFile = dvr%SS_InitInp%InputFile + SeaSt%InitInp%OutRootName = trim(dvr%out%Root)//'.SEA' + SeaSt%InitInp%TMax = dvr%TMax + + IF ( dvr%MHK .NE. 0_IntKi .AND. dvr%IW_InitInp%CompInflow == 1) THEN + SeaSt%InitInp%hasCurrField = .TRUE. + ELSE + SeaSt%InitInp%hasCurrField = .FALSE. + END IF + + CALL SeaSt_Init( SeaSt%InitInp, SeaSt%u, SeaSt%p, SeaSt%x, SeaSt%xd, SeaSt%z, SeaSt%OtherState, SeaSt%y, SeaSt%m, dvr%dt, SeaSt%InitOut, ErrStat, ErrMsg ) + + IF ( dvr%MHK .NE. 0_IntKi .AND. dvr%IW_InitInp%CompInflow == 1 ) THEN ! MHK turbine + ! Simulating an MHK turbine; load dynamic current from IfW + SeaSt%p%WaveField%CurrField => ADI%p%AD%FlowField + SeaSt%p%WaveField%hasCurrField = .TRUE. + ! Set AD pointers to wavefield + ADI%p%AD%WaveField => SeaSt%InitOut%WaveField + ELSE ! Wind turbine + SeaSt%p%WaveField%hasCurrField = .FALSE. + END IF + + if (iCase==1) then + call concatOutputHeaders(dvr%out%WriteOutputHdr, dvr%out%WriteOutputUnt, SeaSt%InitOut%WriteOutputHdr, SeaSt%InitOut%WriteOutputUnt, errStat2, errMsg2); if(Failed()) return + endif + + end if + ! --- Initialize outputs call Dvr_InitializeOutputs(dvr%numTurbines, dvr%out, dvr%numSteps, errStat2, errMsg2); if(Failed()) return @@ -268,11 +311,12 @@ end subroutine Dvr_InitCase !---------------------------------------------------------------------------------------------------------------------------------- !> Perform one time step -subroutine Dvr_TimeStep(nt, dvr, ADI, FED, errStat, errMsg) +subroutine Dvr_TimeStep(nt, dvr, ADI, FED, SeaSt, errStat, errMsg) integer(IntKi) , intent(in ) :: nt ! next time step (current time is nt-1) type(Dvr_SimData), intent(inout) :: dvr ! driver data type(ADI_Data), intent(inout) :: ADI ! Input data for initialization (intent out for getting AD WriteOutput names/units) type(FED_Data), intent(inout) :: FED ! Elastic wind turbine data (Fake ElastoDyn) + type(SeaState_Data) , intent(inout) :: SeaSt !< SeaState data integer(IntKi) , intent( out) :: errStat ! Status of error message character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None ! local variables @@ -295,8 +339,11 @@ subroutine Dvr_TimeStep(nt, dvr, ADI, FED, errStat, errMsg) ! Calculate outputs at nt - 1 (current time) call ADI_CalcOutput(time, ADI%u(2), ADI%p, ADI%x(1), ADI%xd(1), ADI%z(1), ADI%OtherState(1), ADI%y, ADI%m, errStat2, errMsg2 ); if(Failed()) return + ! Call SeaSt_CalcOutput for writing to the file + call SeaSt_CalcOutput( time, SeaSt%u, SeaSt%p, SeaSt%x, SeaSt%xd, SeaSt%z, SeaSt%OtherState, SeaSt%y, SeaSt%m, errStat2, errMsg2 ) + ! Write outputs for all turbines at nt-1 - call Dvr_WriteOutputs(nt, time, dvr, dvr%out, ADI%y, errStat2, errMsg2); if(Failed()) return + call Dvr_WriteOutputs(nt, time, dvr, dvr%out, ADI%y, SeaSt, errStat2, errMsg2); if(Failed()) return ! We store the "driver-level" outputs only now, above, the old outputs are used call Dvr_CalcOutputDriver(dvr, ADI%y, FED, errStat, errMsg) @@ -467,6 +514,9 @@ subroutine Init_ADI_ForDriver(iCase, ADI, dvr, FED, dt, errStat, errMsg) InitInp%IW_InitInp%PLExp = dvr%IW_InitInp%PLExp InitInp%IW_InitInp%MHK = dvr%MHK InitInp%IW_InitInp%FilePassingMethod = 0_IntKi ! read input file instead of passed file data + InitInp%IW_InitInp%WtrDpth = dvr%WtrDpth + InitInp%IW_InitInp%MSL2SWL = dvr%MSL2SWL + InitInp%IW_InitInp%RootName = trim(dvr%out%Root) ! AeroDyn InitInp%AD%Gravity = 9.80665_ReKi InitInp%AD%RootName = dvr%out%Root @@ -988,8 +1038,14 @@ subroutine Dvr_ReadInputFile(fileName, dvr, errStat, errMsg ) dvr%IW_InitInp%HWindSpeed = myNaN endif + ! --- SeaState data + call ParseCom(FileInfo_In, CurLine, Line, errStat2, errMsg2, unEc); if (Failed()) return + call ParseVar(FileInfo_In, CurLine, "CompSeaSt" , dvr%SS_InitInp%CompSeaSt , errStat2, errMsg2, unEc); if (Failed()) return + call ParseVar(FileInfo_In, CurLine, "SeaStFile" , dvr%SS_InitInp%InputFile , errStat2, errMsg2, unEc); if (Failed()) return + if (PathIsRelative(dvr%AD_InputFile)) dvr%AD_InputFile = trim(PriPath)//trim(dvr%AD_InputFile) if (PathIsRelative(dvr%IW_InitInp%InputFile)) dvr%IW_InitInp%InputFile = trim(PriPath)//trim(dvr%IW_InitInp%InputFile) + if (PathIsRelative(dvr%SS_InitInp%InputFile)) dvr%SS_InitInp%InputFile = trim(PriPath)//trim(dvr%SS_InitInp%InputFile) ! --- Turbines call ParseCom(FileInfo_In, CurLine, Line, errStat2, errMsg2, unEc); if (Failed()) return @@ -1345,10 +1401,15 @@ subroutine ValidateInputs(dvr, errStat, errMsg) ! Turbine Data: !if ( dvr%numBlades < 1 ) call SetErrStat( ErrID_Fatal, "There must be at least 1 blade (numBlades).", errStat, ErrMsg, RoutineName) ! Combined-Case Analysis: - if (dvr%MHK /= MHK_None .and. dvr%MHK /= MHK_FixedBottom .and. dvr%MHK /= MHK_Floating) call SetErrStat(ErrID_Fatal, 'MHK switch must be 0, 1, or 2.', ErrStat, ErrMsg, RoutineName) - if (dvr%DT < epsilon(0.0_ReKi) ) call SetErrStat(ErrID_Fatal,'dT must be larger than 0.',errStat, errMsg,RoutineName) if (Check(.not.(ANY((/0,1/) == dvr%IW_InitInp%compInflow) ), 'CompInflow needs to be 0 or 1')) return + if (Check(.not.(ANY((/0,1/) == dvr%SS_InitInp%CompSeaSt) ), 'CompSeaSt needs to be 0 or 1')) return + + if (dvr%MHK /= MHK_None .and. dvr%MHK /= MHK_FixedBottom .and. dvr%MHK /= MHK_Floating) call SetErrStat(ErrID_Fatal, 'MHK switch must be 0, 1, or 2.', ErrStat, ErrMsg, RoutineName) + + if (dvr%MHK /= MHK_None .and. dvr%SS_InitInp%CompSeaSt == 1 .and. dvr%IW_InitInp%CompInflow /= 1) call SetErrStat( ErrID_Fatal, 'InflowWind must be activated for MHK turbines when SeaState is used.', ErrStat, ErrMsg, RoutineName ) + + if (dvr%MHK == MHK_None .and. dvr%SS_InitInp%CompSeaSt /= 0) call SetErrStat( ErrID_Fatal, 'SeaState cannot be used with wind turbines.', ErrStat, ErrMsg, RoutineName ) if (Check(.not.(ANY(idAnalysisVALID == dvr%analysisType )), 'Analysis type not supported: '//trim(Num2LStr(dvr%analysisType)) )) return @@ -1641,26 +1702,38 @@ subroutine Dvr_CalcOutputDriver(dvr, y_ADI, FED, errStat, errMsg) end subroutine Dvr_CalcOutputDriver !---------------------------------------------------------------------------------------------------------------------------------- -subroutine Dvr_WriteOutputs(nt, t, dvr, out, yADI, errStat, errMsg) +subroutine Dvr_WriteOutputs(nt, t, dvr, out, yADI, SeaSt, errStat, errMsg) integer(IntKi) , intent(in ) :: nt ! simulation time step real(DbKi) , intent(in ) :: t ! simulation time (s) - type(Dvr_SimData), intent(inout) :: dvr ! driver data + type(Dvr_SimData) , intent(inout) :: dvr ! driver data type(Dvr_Outputs) , intent(inout) :: out ! driver uotput options type(ADI_OutputType) , intent(in ) :: yADI ! aerodyn outputs + type(SeaState_Data) , intent(inout) :: SeaSt ! SeaState data integer(IntKi) , intent(inout) :: errStat ! Status of error message character(*) , intent(inout) :: errMsg ! Error message if errStat /= ErrID_None ! Local variables. character(ChanLen) :: tmpStr ! temporary string to print the time output as text - integer :: nDV , nAD, nIW, iWT, k, j + integer :: nDV , nAD, nIW, nSS, iWT, k, j real(ReKi) :: rotations(3) integer(IntKi) :: errStat2 ! Status of error message character(ErrMsgLen) :: errMsg2 ! Error message errStat = ErrID_None errMsg = '' + IF ( .not. allocated( SeaSt%y%WriteOutput ) ) then + ALLOCATE ( SeaSt%y%WriteOutput ( SeaSt%p%NumOuts ) , STAT=ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrMsg = ' Error allocating memory for the SeaState WriteOutput array.' + ErrStat = ErrID_Fatal + RETURN + END IF + SeaSt%y%WriteOutput = 0.0_ReKi + END IF + ! Packing all outputs excpet time into one array nAD = size(yADI%AD%rotors(1)%WriteOutput) nIW = size(yADI%IW_WriteOutput) + nSS = size(SeaSt%y%WriteOutput) nDV = out%nDvrOutputs do iWT = 1, dvr%numTurbines if (dvr%wt(iWT)%numBlades >0 ) then ! TODO, export for tower only @@ -1668,8 +1741,9 @@ subroutine Dvr_WriteOutputs(nt, t, dvr, out, yADI, errStat, errMsg) out%outLine(1:nDV) = dvr%wt(iWT)%WriteOutput(1:nDV) ! Driver Write Outputs ! out%outLine(11) = dvr%WT(iWT)%hub%azimuth ! azimuth already stored a nt-1 - out%outLine(nDV+1:nDV+nIW) = yADI%IW_WriteOutput ! InflowWind WriteOutputs - out%outLine(nDV+nIW+1:) = yADI%AD%rotors(iWT)%WriteOutput ! AeroDyn WriteOutputs + out%outLine(nDV+1:nDV+nIW) = yADI%IW_WriteOutput ! InflowWind WriteOutputs + out%outLine(nDV+nIW+1:nDV+nIW+nAD) = yADI%AD%rotors(iWT)%WriteOutput ! AeroDyn WriteOutputs + out%outLine(nDV+nIW+nAD+1:) = SeaSt%y%WriteOutput ! SeaState WriteOutputs if (out%fileFmt==idFmtBoth .or. out%fileFmt == idFmtAscii) then ! ASCII @@ -1682,7 +1756,7 @@ subroutine Dvr_WriteOutputs(nt, t, dvr, out, yADI, errStat, errMsg) endif if (out%fileFmt==idFmtBoth .or. out%fileFmt == idFmtBinary) then ! Store for binary - out%storage(1:nDV+nIW+nAD, nt, iWT) = out%outLine(1:nDV+nIW+nAD) + out%storage(1:nDV+nIW+nAD+nSS, nt, iWT) = out%outLine(1:nDV+nIW+nAD+nSS) endif endif enddo diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index f1122aded8..fd0ed3e19a 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -186,6 +186,7 @@ MODULE AeroDyn_Driver_Types character(1024) :: root !< Output file rootname [-] TYPE(Dvr_Outputs) :: out !< data for driver output file [-] TYPE(ADI_IW_InputData) :: IW_InitInp !< [-] + TYPE(SeaSt_InitInputType) :: SS_InitInp !< [-] END TYPE Dvr_SimData ! ======================= ! ========= AllData ======= @@ -196,9 +197,11 @@ MODULE AeroDyn_Driver_Types INTEGER(IntKi) :: errStat = 0_IntKi !< [-] character(ErrMsgLen) :: errMsg !< [-] LOGICAL :: initialized = .false. !< [-] + TYPE(SeaState_Data) :: SeaSt !< SeaState data [-] END TYPE AllData ! ======================= -CONTAINS + +contains subroutine AD_Dvr_CopyDvr_Case(SrcDvr_CaseData, DstDvr_CaseData, CtrlCode, ErrStat, ErrMsg) type(Dvr_Case), intent(in) :: SrcDvr_CaseData @@ -1200,6 +1203,9 @@ subroutine AD_Dvr_CopyDvr_SimData(SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCo call ADI_CopyIW_InputData(SrcDvr_SimDataData%IW_InitInp, DstDvr_SimDataData%IW_InitInp, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + call SeaSt_CopyInitInput(SrcDvr_SimDataData%SS_InitInp, DstDvr_SimDataData%SS_InitInp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine AD_Dvr_DestroyDvr_SimData(Dvr_SimDataData, ErrStat, ErrMsg) @@ -1238,6 +1244,8 @@ subroutine AD_Dvr_DestroyDvr_SimData(Dvr_SimDataData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call ADI_DestroyIW_InputData(Dvr_SimDataData%IW_InitInp, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyInitInput(Dvr_SimDataData%SS_InitInp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_Dvr_PackDvr_SimData(RF, Indata) @@ -1286,6 +1294,7 @@ subroutine AD_Dvr_PackDvr_SimData(RF, Indata) call RegPack(RF, InData%root) call AD_Dvr_PackDvr_Outputs(RF, InData%out) call ADI_PackIW_InputData(RF, InData%IW_InitInp) + call SeaSt_PackInitInput(RF, InData%SS_InitInp) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1345,6 +1354,7 @@ subroutine AD_Dvr_UnPackDvr_SimData(RF, OutData) call RegUnpack(RF, OutData%root); if (RegCheckErr(RF, RoutineName)) return call AD_Dvr_UnpackDvr_Outputs(RF, OutData%out) ! out call ADI_UnpackIW_InputData(RF, OutData%IW_InitInp) ! IW_InitInp + call SeaSt_UnpackInitInput(RF, OutData%SS_InitInp) ! SS_InitInp end subroutine subroutine AD_Dvr_CopyAllData(SrcAllDataData, DstAllDataData, CtrlCode, ErrStat, ErrMsg) @@ -1370,6 +1380,9 @@ subroutine AD_Dvr_CopyAllData(SrcAllDataData, DstAllDataData, CtrlCode, ErrStat, DstAllDataData%errStat = SrcAllDataData%errStat DstAllDataData%errMsg = SrcAllDataData%errMsg DstAllDataData%initialized = SrcAllDataData%initialized + call ADI_CopySeaState_Data(SrcAllDataData%SeaSt, DstAllDataData%SeaSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine AD_Dvr_DestroyAllData(AllDataData, ErrStat, ErrMsg) @@ -1387,6 +1400,8 @@ subroutine AD_Dvr_DestroyAllData(AllDataData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call ADI_DestroyFED_Data(AllDataData%FED, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADI_DestroySeaState_Data(AllDataData%SeaSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_Dvr_PackAllData(RF, Indata) @@ -1400,6 +1415,7 @@ subroutine AD_Dvr_PackAllData(RF, Indata) call RegPack(RF, InData%errStat) call RegPack(RF, InData%errMsg) call RegPack(RF, InData%initialized) + call ADI_PackSeaState_Data(RF, InData%SeaSt) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1414,6 +1430,9 @@ subroutine AD_Dvr_UnPackAllData(RF, OutData) call RegUnpack(RF, OutData%errStat); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%errMsg); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%initialized); if (RegCheckErr(RF, RoutineName)) return + call ADI_UnpackSeaState_Data(RF, OutData%SeaSt) ! SeaSt end subroutine + END MODULE AeroDyn_Driver_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn_IO.f90 b/modules/aerodyn/src/AeroDyn_IO.f90 index a3e56406a7..75fb8e2b45 100644 --- a/modules/aerodyn/src/AeroDyn_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_IO.f90 @@ -177,7 +177,7 @@ subroutine Calc_WriteOutput_AD() m%AllOuts( TwNFdy( beta) ) = m%Y_Twr(j) end do ! out nodes - if ( p%Buoyancy ) then + if ( p%MHK > 0 ) then do beta=1,p%NTwOuts j = p%TwOutNd(beta) @@ -194,7 +194,7 @@ subroutine Calc_WriteOutput_AD() end if ! hub outputs - if ( p%Buoyancy ) then + if ( p%MHK > 0 ) then tmpHubFB = matmul( u%HubMotion%Orientation(:,:,1) , m%HubFB ) m%AllOuts( HbFbx ) = tmpHubFB(1) m%AllOuts( HbFby ) = tmpHubFB(2) @@ -210,7 +210,7 @@ subroutine Calc_WriteOutput_AD() end if ! nacelle buoyancy outputs - if ( p%Buoyancy ) then + if ( p%MHK > 0 ) then tmp = matmul( u%NacelleMotion%Orientation(:,:,1) , m%NacFB ) m%AllOuts( NcFbx ) = tmp(1) m%AllOuts( NcFby ) = tmp(2) @@ -237,7 +237,7 @@ subroutine Calc_WriteOutput_AD() end if ! nacelle total forces and moments - if ( p%Buoyancy .OR. p%NacelleDrag) then + if ( p%MHK > 0 .OR. p%NacelleDrag) then tmp = m%NacFi m%AllOuts( NcFxi ) = tmp(1) @@ -278,7 +278,7 @@ subroutine Calc_WriteOutput_AD() end do ! nodes end do ! blades - if ( p%Buoyancy ) then + if ( p%MHK > 0 ) then do k=1,min(p%numBlades,AD_MaxBl_Out) ! limit this do beta=1,p%NBlOuts j=p%BlOutNd(beta) @@ -705,7 +705,7 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade character(ErrMsgLen) :: ErrMsg2 !< Temporary Error message character(ErrMsgLen) :: ErrMsg_NoAllBldNdOuts integer(IntKi) :: CurLine !< current entry in FileInfo_In%Lines array - real(ReKi) :: TmpRe5(5) !< temporary 8 number array for reading values in + real(ReKi) :: TmpRe7(7) !< temporary 8 number array for reading values in logical :: TwrAeroLogical !< convert TwrAero from logical (input file) to integer (new) character(1024) :: sDummy !< temporary string character(1024) :: tmpOutStr !< temporary string for writing to screen @@ -807,9 +807,6 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade frozenWakeProvided = legacyInputPresent('FrozenWake', Curline, ErrStat2, ErrMsg2, 'DBEMTMod=-1 (FrozenWake=True) or DBEMTMod>-1 (FrozenWake=False)') ! CavitCheck - Perform cavitation check? (flag) [AFAeroMod must be 1 when CavitCheck=true] call ParseVar( FileInfo_In, CurLine, "CavitCheck", InputFileData%CavitCheck, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return - ! Buoyancy - Include buoyancy effects? (flag) - call ParseVar( FileInfo_In, CurLine, "Buoyancy", InputFileData%Buoyancy, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return ! NacelleDrag - Include Nacelle Drag effects? (flag) call ParseVar( FileInfo_In, CurLine, "NacelleDrag", InputFileData%NacelleDrag, ErrStat2, ErrMsg2, UnEc ) @@ -1039,7 +1036,7 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade IF ( PathIsRelative( InputFileData%ADBlFile(I) ) ) InputFileData%ADBlFile(I) = TRIM(PriPath)//TRIM(InputFileData%ADBlFile(I)) enddo - !====== Hub Properties ============================================================================== [used only when Buoyancy=True] + !====== Hub Properties ============================================================================== [used only when MHK=1 or 2] do iR = 1,size(NumBlades) ! Loop on rotors if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo CurLine = CurLine + 1 @@ -1051,7 +1048,7 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade if (Failed()) return end do - !====== Nacelle Properties ========================================================================== [used only when Buoyancy=True] + !====== Nacelle Properties ========================================================================== [used only when MHK=1 or 2] do iR = 1,size(NumBlades) ! Loop on rotors if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo CurLine = CurLine + 1 @@ -1088,14 +1085,14 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade endif enddo - !====== Tower Influence and Aerodynamics ============================================================ [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True] + !====== Tower Influence and Aerodynamics ============================================================ [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2] do iR = 1,size(NumBlades) ! Loop on rotors if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo CurLine = CurLine + 1 - ! NumTwrNds - Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True] + ! NumTwrNds - Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2] call ParseVar( FileInfo_In, CurLine, "NumTwrNds", InputFileData%rotors(iR)%NumTwrNds, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return - !TwrElev TwrDiam TwrCd TwrTI TwrCb + !TwrElev TwrDiam TwrCd TwrTI TwrCb TwrCp TwrCa if ( InputFileData%Echo ) WRITE(UnEc, '(A)') 'Tower Table Header: '//FileInfo_In%Lines(CurLine) ! Write section break to echo CurLine = CurLine + 1 !(m) (m) (-) (-) (-) @@ -1112,14 +1109,20 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade if (Failed()) return CALL AllocAry( InputFileData%rotors(iR)%TwrCb, InputFileData%rotors(iR)%NumTwrNds, 'TwrCb', ErrStat2, ErrMsg2) if (Failed()) return + CALL AllocAry( InputFileData%rotors(iR)%TwrCp, InputFileData%rotors(iR)%NumTwrNds, 'TwrCp', ErrStat2, ErrMsg2) + if (Failed()) return + CALL AllocAry( InputFileData%rotors(iR)%TwrCa, InputFileData%rotors(iR)%NumTwrNds, 'TwrCa', ErrStat2, ErrMsg2) + if (Failed()) return do I=1,InputFileData%rotors(iR)%NumTwrNds - call ParseAry ( FileInfo_In, CurLine, 'Properties for tower node '//trim( Int2LStr( I ) )//'.', TmpRe5, 5, ErrStat2, ErrMsg2, UnEc ) + call ParseAry ( FileInfo_In, CurLine, 'Properties for tower node '//trim( Int2LStr( I ) )//'.', TmpRe7, 7, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; - InputFileData%rotors(iR)%TwrElev(I) = TmpRe5( 1) - InputFileData%rotors(iR)%TwrDiam(I) = TmpRe5( 2) - InputFileData%rotors(iR)%TwrCd(I) = TmpRe5( 3) - InputFileData%rotors(iR)%TwrTI(I) = TmpRe5( 4) - InputFileData%rotors(iR)%TwrCb(I) = TmpRe5( 5) + InputFileData%rotors(iR)%TwrElev(I) = TmpRe7( 1) + InputFileData%rotors(iR)%TwrDiam(I) = TmpRe7( 2) + InputFileData%rotors(iR)%TwrCd(I) = TmpRe7( 3) + InputFileData%rotors(iR)%TwrTI(I) = TmpRe7( 4) + InputFileData%rotors(iR)%TwrCb(I) = TmpRe7( 5) + InputFileData%rotors(iR)%TwrCp(I) = TmpRe7( 6) + InputFileData%rotors(iR)%TwrCa(I) = TmpRe7( 7) end do enddo @@ -1432,11 +1435,11 @@ SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, AeroProjMod, UnEc, c INTEGER( IntKi ) :: UnIn ! Unit number for reading file INTEGER(IntKi) :: ErrStat2 , IOS ! Temporary Error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Err msg - INTEGER, PARAMETER :: MaxCols = 10 + INTEGER, PARAMETER :: MaxCols = 16 CHARACTER(NWTC_SizeOfNumWord*(MaxCols+1)) :: Line INTEGER(IntKi) :: Indx(MaxCols) - CHARACTER(8), PARAMETER :: AvailableChanNames(MaxCols) = (/'BLSPN ', 'BLCRVAC ','BLSWPAC ','BLCRVANG','BLTWIST ','BLCHORD ', 'BLAFID ', 'BLCB ', 'BLCENBN ','BLCENBT ' /) ! in upper case only - LOGICAL, PARAMETER :: RequiredChanNames( MaxCols) = (/.true. , .true. ,.true. ,.false. ,.true. ,.true. , .true. , .false. , .false. ,.false. /) + CHARACTER(8), PARAMETER :: AvailableChanNames(MaxCols) = (/'BLSPN ', 'BLCRVAC ','BLSWPAC ','BLCRVANG','BLTWIST ','BLCHORD ', 'BLAFID ', 'T_C ', 'BLCB ', 'BLCENBN ','BLCENBT ','BLCPN ','BLCPT ','BLCAN ','BLCAT ','BLCAM ' /) ! in upper case only + LOGICAL, PARAMETER :: RequiredChanNames( MaxCols) = (/.true. , .true. ,.true. ,.false. ,.true. ,.true. , .true. , .false. , .false. ,.false. ,.false. ,.false. ,.false. ,.false. ,.false. ,.false. /) CHARACTER(*), PARAMETER :: RoutineName = 'ReadBladeInputs' @@ -1503,13 +1506,25 @@ SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, AeroProjMod, UnEc, c CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry( BladeKInputFileData%BlAFID, BladeKInputFileData%NumBlNds, 'BlAFID', ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocAry( BladeKInputFileData%t_c, BladeKInputFileData%NumBlNds, 't_c', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry( BladeKInputFileData%BlCb, BladeKInputFileData%NumBlNds, 'BlCb', ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry( BladeKInputFileData%BlCenBn, BladeKInputFileData%NumBlNds, 'BlCenBn', ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry( BladeKInputFileData%BlCenBt, BladeKInputFileData%NumBlNds, 'BlCenBt', ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + CALL AllocAry( BladeKInputFileData%BlCpn, BladeKInputFileData%NumBlNds, 'BlCpn', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocAry( BladeKInputFileData%BlCpt, BladeKInputFileData%NumBlNds, 'BlCpt', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocAry( BladeKInputFileData%BlCan, BladeKInputFileData%NumBlNds, 'BlCan', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocAry( BladeKInputFileData%BlCat, BladeKInputFileData%NumBlNds, 'BlCat', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocAry( BladeKInputFileData%BlCam, BladeKInputFileData%NumBlNds, 'BlCam', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Return on error if we didn't allocate space for the next inputs IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() @@ -1518,9 +1533,15 @@ SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, AeroProjMod, UnEc, c ! Initialize in case these columns are missing (e.g., no buoyancy, or cant angle) BladeKInputFileData%BlCrvAng = 0.0_ReKi + BladeKInputFileData%t_c = 0.0_ReKi BladeKInputFileData%BlCb = 0.0_ReKi BladeKInputFileData%BlCenBn = 0.0_ReKi BladeKInputFileData%BlCenBt = 0.0_ReKi + BladeKInputFileData%BlCpn = 0.0_ReKi + BladeKInputFileData%BlCpt = 0.0_ReKi + BladeKInputFileData%BlCan = 0.0_ReKi + BladeKInputFileData%BlCat = 0.0_ReKi + BladeKInputFileData%BlCam = 0.0_ReKi ! figure out what columns are specified in this file and in what order: @@ -1628,19 +1649,49 @@ SUBROUTINE ConvertLineToCols(Line, i, Indx, BladeKInputFileData, ErrStat, ErrMsg c=Indx(8) IF (c > 0) THEN - READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCb(I) + READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%t_c(I) END IF c=Indx(9) IF (c > 0) THEN - READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCenBn(I) + READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCb(I) END IF c=Indx(10) + IF (c > 0) THEN + READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCenBn(I) + END IF + + c=Indx(11) IF (c > 0) THEN READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCenBt(I) END IF + c=Indx(12) + IF (c > 0) THEN + READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCpn(I) + END IF + + c=Indx(13) + IF (c > 0) THEN + READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCpt(I) + END IF + + c=Indx(14) + IF (c > 0) THEN + READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCan(I) + END IF + + c=Indx(15) + IF (c > 0) THEN + READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCat(I) + END IF + + c=Indx(16) + IF (c > 0) THEN + READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCam(I) + END IF + IF (ANY(IOS /= 0)) THEN CALL SetErrStat(ErrID_Fatal, "Unable to read numeric data from all columns in the table on row "//trim(num2lstr(i))//".", ErrStat, ErrMsg, RoutineName) RETURN @@ -1824,15 +1875,6 @@ SUBROUTINE AD_PrintSum( InputFileData, p, p_AD, u, y, NumBlades, BladeInputFileD Msg = 'No' end if WRITE (UnSu,Ec_LgFrmt) p%CavitCheck, 'CavitCheck', 'Perform cavitation check? '//TRIM(Msg) - - ! Buoyancy - if (p%Buoyancy) then - Msg = 'Yes' - else - Msg = 'No' - end if - WRITE (UnSu,Ec_LgFrmt) p%Buoyancy, 'Buoyancy', 'Include buoyancy effects? '//TRIM(Msg) - ! Nacelle Drag if (p%NacelleDrag) then Msg = 'Yes' @@ -2123,7 +2165,7 @@ SUBROUTINE SetOutParam(OutList, p, p_AD, ErrStat, ErrMsg ) InvalidOutput( DBEMTau1 ) = .true. end if - if (.not. p%Buoyancy) then ! Invalid buoyant loads + if ( p%MHK == 0 ) then ! Invalid buoyant loads InvalidOutput( HbFbx ) = .true. InvalidOutput( HbFby ) = .true. InvalidOutput( HbFbz ) = .true. @@ -2172,7 +2214,7 @@ SUBROUTINE SetOutParam(OutList, p, p_AD, ErrStat, ErrMsg ) end if - if (.not. (p%NacelleDrag .OR. p%Buoyancy)) then ! Invalid Nacelle Total loads + if (.not. (p%NacelleDrag .OR. p%MHK > 0)) then ! Invalid Nacelle Total loads InvalidOutput( NcFxi ) = .true. InvalidOutput( NcFyi ) = .true. InvalidOutput( NcFzi ) = .true. diff --git a/modules/aerodyn/src/AeroDyn_Inflow.f90 b/modules/aerodyn/src/AeroDyn_Inflow.f90 index 3f212d78e3..d4b4726250 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow.f90 @@ -380,6 +380,8 @@ subroutine ADI_InitInflowWind(Root, i_IW, u_AD, o_AD, IW, dt, InitOutData, errSt InitInData%InputFileName = i_IW%InputFile InitInData%Linearize = i_IW%Linearize InitInData%FilePassingMethod= i_IW%FilePassingMethod + InitInData%WtrDpth = i_IW%WtrDpth + InitInData%MSL2SWL = i_IW%MSL2SWL InitInData%NumWindPoints = 1 if (i_IW%FilePassingMethod == 1_IntKi) then ! passing input file as an FileInfoType structure call NWTC_Library_Copyfileinfotype( i_IW%PassedFileInfo, InitInData%PassedFileInfo, MESH_NEWCOPY, errStat2, errMsg2 ); if (Failed()) return @@ -388,6 +390,7 @@ subroutine ADI_InitInflowWind(Root, i_IW, u_AD, o_AD, IW, dt, InitOutData, errSt endif InitInData%RootName = trim(Root)//'.IfW' InitInData%MHK = i_IW%MHK + InitInData%OutputAccel = InitInData%MHK > 0 ! OLAF might be used in AD, in which case we need to allow out of bounds for some calcs. To do that ! the average values for the entire wind profile must be calculated and stored (we don't know if OLAF ! is used until after AD_Init below). diff --git a/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 b/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 index 48f0d4601f..84b1dfabb7 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 @@ -48,6 +48,7 @@ MODULE AeroDyn_Inflow_C_BINDING !------------------------------------------------------------------------------------ ! Debugging: DebugLevel -- passed at PreInit + ! Debugging: DebugLevel -- passed at PreInit ! 0 - none ! 1 - some summary info ! 2 - above + all position/orientation info @@ -103,6 +104,9 @@ MODULE AeroDyn_Inflow_C_BINDING type(ADI_InitOutputType) :: InitOutData !< Initial output data -- Names, units, and version info. type(ADI_InputType) :: ADI_u !< ADI inputs -- set by AD_SetInputMotion. Copied as needed (necessary for correction steps) !------------------------------ + ! Primary SeaSt data derived data types + type(SeaState_Data) :: SeaSt !< SeaState data + !------------------------------ ! Simulation data type(Dvr_SimData) :: Sim !< Data about the simulation !------------------------------ @@ -882,7 +886,7 @@ subroutine SetupFileOutputs() WrOutputsData%unOutFile = -1 !FIXME: number of timesteps is incorrect! call Dvr_InitializeOutputs(Sim%numTurbines, WrOutputsData, Sim%numSteps-1, ErrStat2, ErrMsg2); if(Failed()) return - call Dvr_WriteOutputs(n_Global+1, ADI%InputTimes(INPUT_CURR), Sim, WrOutputsData, ADI%y, errStat2, errMsg2); if(Failed()) return + call Dvr_WriteOutputs(n_Global+1, ADI%InputTimes(INPUT_CURR), Sim, WrOutputsData, ADI%y, SeaSt, errStat2, errMsg2); if(Failed()) return end subroutine SetupFileOutputs @@ -1135,7 +1139,7 @@ SUBROUTINE ADI_C_CalcOutput(Time_C, & if (WrOutputsData%fileFmt > idFmtNone) then !FIXME: need some way to overwrite the correction timesteps (for text file)! - call Dvr_WriteOutputs(n_Global+1, ADI%InputTimes(INPUT_CURR), Sim, WrOutputsData, ADI%y, errStat2, errMsg2); if(Failed()) return + call Dvr_WriteOutputs(n_Global+1, ADI%InputTimes(INPUT_CURR), Sim, WrOutputsData, ADI%y, SeaSt, errStat2, errMsg2); if(Failed()) return endif ! Set error status diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Registry.txt b/modules/aerodyn/src/AeroDyn_Inflow_Registry.txt index 678ea45947..ead8a85f3e 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Inflow_Registry.txt @@ -13,6 +13,7 @@ include Registry_NWTC_Library.txt usefrom AeroDyn_Registry.txt usefrom InflowWind.txt +usefrom SeaState.txt param AeroDyn_Inflow/ADI - IntKi ADI_Version - 1 - "" - @@ -41,6 +42,9 @@ typedef ^ ^ IntKi FilePass typedef ^ ^ FileInfoType PassedFileInfo - - - "If we don't use the input file, pass everything through this as a FileInfo structure" - typedef ^ ^ InflowWind_InputFile PassedFileData - - - "If we don't use the input file, pass everything through this as an IfW InputFile structure" - typedef ^ ^ LOGICAL Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - +typedef ^ ^ ReKi WtrDpth - - - "Water depth" m +typedef ^ ^ ReKi MSL2SWL - - - "Offset between still-water level and mean sea level" m +typedef ^ ^ Character(1024) RootName - - - "RootName for writing output files" - # ..... InitIn .................................................................................................................... @@ -108,6 +112,18 @@ typedef ^ ^ ADI_InputType u typedef ^ ^ ADI_OutputType y - - - "System outputs" typedef ^ ^ DbKi inputTimes {:} - - "Array of times associated with u array" +# ..... SeaState data ....................................................................................................... +typedef ^ SeaState_Data SeaSt_ContinuousStateType x - - - "Continuous states" +typedef ^ ^ SeaSt_DiscreteStateType xd - - - "Discrete states" +typedef ^ ^ SeaSt_ConstraintStateType z - - - "Constraint states" +typedef ^ ^ SeaSt_OtherStateType OtherState - - - "Other states" +typedef ^ ^ SeaSt_ParameterType p - - - "Parameters" +typedef ^ ^ SeaSt_InputType u - - - "System inputs" +typedef ^ ^ SeaSt_OutputType y - - - "System outputs" +typedef ^ ^ SeaSt_MiscVarType m - - - "Misc/optimization variables" +typedef ^ ^ SeaSt_InitInputType InitInp - - - "Array of inputs associated with InputTimes" +typedef ^ ^ SeaSt_InitOutputType InitOut - - - "Array of outputs associated with CalcSteady Azimuths" + # ..... Rotor elastic data .................................................................................................. # NOTE: useful for driver/wrapper of this module typedef ^ RotFED MeshType PlatformPtMesh - - - "Platform reference point positions/orientations/velocities/accelerations" - diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index 295764d98a..499c040e84 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -32,9 +32,10 @@ MODULE AeroDyn_Inflow_Types !--------------------------------------------------------------------------------------------------------------------------------- USE AeroDyn_Types +USE SeaState_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_Version = 1 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_Version = 1 ! [-] ! ========= ADI_InflowWindData ======= TYPE, PUBLIC :: ADI_InflowWindData TYPE(InflowWind_ContinuousStateType) :: x !< Continuous states [-] @@ -63,6 +64,9 @@ MODULE AeroDyn_Inflow_Types TYPE(FileInfoType) :: PassedFileInfo !< If we don't use the input file, pass everything through this as a FileInfo structure [-] TYPE(InflowWind_InputFile) :: PassedFileData !< If we don't use the input file, pass everything through this as an IfW InputFile structure [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] + Character(1024) :: RootName !< RootName for writing output files [-] END TYPE ADI_IW_InputData ! ======================= ! ========= ADI_InitInputType ======= @@ -149,6 +153,20 @@ MODULE AeroDyn_Inflow_Types REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: inputTimes !< Array of times associated with u array [-] END TYPE ADI_Data ! ======================= +! ========= SeaState_Data ======= + TYPE, PUBLIC :: SeaState_Data + TYPE(SeaSt_ContinuousStateType) :: x !< Continuous states [-] + TYPE(SeaSt_DiscreteStateType) :: xd !< Discrete states [-] + TYPE(SeaSt_ConstraintStateType) :: z !< Constraint states [-] + TYPE(SeaSt_OtherStateType) :: OtherState !< Other states [-] + TYPE(SeaSt_ParameterType) :: p !< Parameters [-] + TYPE(SeaSt_InputType) :: u !< System inputs [-] + TYPE(SeaSt_OutputType) :: y !< System outputs [-] + TYPE(SeaSt_MiscVarType) :: m !< Misc/optimization variables [-] + TYPE(SeaSt_InitInputType) :: InitInp !< Array of inputs associated with InputTimes [-] + TYPE(SeaSt_InitOutputType) :: InitOut !< Array of outputs associated with CalcSteady Azimuths [-] + END TYPE SeaState_Data +! ======================= ! ========= RotFED ======= TYPE, PUBLIC :: RotFED TYPE(MeshType) :: PlatformPtMesh !< Platform reference point positions/orientations/velocities/accelerations [-] @@ -175,7 +193,41 @@ MODULE AeroDyn_Inflow_Types TYPE(RotFED) , DIMENSION(:), ALLOCATABLE :: WT !< Wind turbine/rotors elastic data [-] END TYPE FED_Data ! ======================= -CONTAINS + integer(IntKi), public, parameter :: ADI_x_AD_rotors_BEMT_UA_element_x = 1 ! ADI%AD%rotors(DL%i1)%BEMT%UA%element(DL%i2, DL%i3)%x + integer(IntKi), public, parameter :: ADI_x_AD_rotors_BEMT_DBEMT_element_vind = 2 ! ADI%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind + integer(IntKi), public, parameter :: ADI_x_AD_rotors_BEMT_DBEMT_element_vind_1 = 3 ! ADI%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind_1 + integer(IntKi), public, parameter :: ADI_x_AD_rotors_BEMT_V_w = 4 ! ADI%AD%rotors(DL%i1)%BEMT%V_w + integer(IntKi), public, parameter :: ADI_x_AD_rotors_AA_DummyContState = 5 ! ADI%AD%rotors(DL%i1)%AA%DummyContState + integer(IntKi), public, parameter :: ADI_x_AD_FVW_W_Gamma_NW = 6 ! ADI%AD%FVW%W(DL%i1)%Gamma_NW + integer(IntKi), public, parameter :: ADI_x_AD_FVW_W_Gamma_FW = 7 ! ADI%AD%FVW%W(DL%i1)%Gamma_FW + integer(IntKi), public, parameter :: ADI_x_AD_FVW_W_Eps_NW = 8 ! ADI%AD%FVW%W(DL%i1)%Eps_NW + integer(IntKi), public, parameter :: ADI_x_AD_FVW_W_Eps_FW = 9 ! ADI%AD%FVW%W(DL%i1)%Eps_FW + integer(IntKi), public, parameter :: ADI_x_AD_FVW_W_r_NW = 10 ! ADI%AD%FVW%W(DL%i1)%r_NW + integer(IntKi), public, parameter :: ADI_x_AD_FVW_W_r_FW = 11 ! ADI%AD%FVW%W(DL%i1)%r_FW + integer(IntKi), public, parameter :: ADI_x_AD_FVW_UA_element_x = 12 ! ADI%AD%FVW%UA(DL%i1)%element(DL%i2, DL%i3)%x + integer(IntKi), public, parameter :: ADI_z_AD_rotors_BEMT_phi = 13 ! ADI%AD%rotors(DL%i1)%BEMT%phi + integer(IntKi), public, parameter :: ADI_z_AD_rotors_AA_DummyConstrState = 14 ! ADI%AD%rotors(DL%i1)%AA%DummyConstrState + integer(IntKi), public, parameter :: ADI_z_AD_FVW_W_Gamma_LL = 15 ! ADI%AD%FVW%W(DL%i1)%Gamma_LL + integer(IntKi), public, parameter :: ADI_z_AD_FVW_residual = 16 ! ADI%AD%FVW%residual + integer(IntKi), public, parameter :: ADI_u_AD_rotors_NacelleMotion = 17 ! ADI%AD%rotors(DL%i1)%NacelleMotion + integer(IntKi), public, parameter :: ADI_u_AD_rotors_TowerMotion = 18 ! ADI%AD%rotors(DL%i1)%TowerMotion + integer(IntKi), public, parameter :: ADI_u_AD_rotors_HubMotion = 19 ! ADI%AD%rotors(DL%i1)%HubMotion + integer(IntKi), public, parameter :: ADI_u_AD_rotors_BladeRootMotion = 20 ! ADI%AD%rotors(DL%i1)%BladeRootMotion(DL%i2) + integer(IntKi), public, parameter :: ADI_u_AD_rotors_BladeMotion = 21 ! ADI%AD%rotors(DL%i1)%BladeMotion(DL%i2) + integer(IntKi), public, parameter :: ADI_u_AD_rotors_TFinMotion = 22 ! ADI%AD%rotors(DL%i1)%TFinMotion + integer(IntKi), public, parameter :: ADI_u_AD_rotors_UserProp = 23 ! ADI%AD%rotors(DL%i1)%UserProp + integer(IntKi), public, parameter :: ADI_y_AD_rotors_NacelleLoad = 24 ! ADI%AD%rotors(DL%i1)%NacelleLoad + integer(IntKi), public, parameter :: ADI_y_AD_rotors_HubLoad = 25 ! ADI%AD%rotors(DL%i1)%HubLoad + integer(IntKi), public, parameter :: ADI_y_AD_rotors_TowerLoad = 26 ! ADI%AD%rotors(DL%i1)%TowerLoad + integer(IntKi), public, parameter :: ADI_y_AD_rotors_BladeLoad = 27 ! ADI%AD%rotors(DL%i1)%BladeLoad(DL%i2) + integer(IntKi), public, parameter :: ADI_y_AD_rotors_TFinLoad = 28 ! ADI%AD%rotors(DL%i1)%TFinLoad + integer(IntKi), public, parameter :: ADI_y_AD_rotors_WriteOutput = 29 ! ADI%AD%rotors(DL%i1)%WriteOutput + integer(IntKi), public, parameter :: ADI_y_HHVel = 30 ! ADI%HHVel + integer(IntKi), public, parameter :: ADI_y_PLExp = 31 ! ADI%PLExp + integer(IntKi), public, parameter :: ADI_y_IW_WriteOutput = 32 ! ADI%IW_WriteOutput + integer(IntKi), public, parameter :: ADI_y_WriteOutput = 33 ! ADI%WriteOutput + +contains subroutine ADI_CopyInflowWindData(SrcInflowWindDataData, DstInflowWindDataData, CtrlCode, ErrStat, ErrMsg) type(ADI_InflowWindData), intent(in) :: SrcInflowWindDataData @@ -309,6 +361,9 @@ subroutine ADI_CopyIW_InputData(SrcIW_InputDataData, DstIW_InputDataData, CtrlCo call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstIW_InputDataData%Linearize = SrcIW_InputDataData%Linearize + DstIW_InputDataData%WtrDpth = SrcIW_InputDataData%WtrDpth + DstIW_InputDataData%MSL2SWL = SrcIW_InputDataData%MSL2SWL + DstIW_InputDataData%RootName = SrcIW_InputDataData%RootName end subroutine subroutine ADI_DestroyIW_InputData(IW_InputDataData, ErrStat, ErrMsg) @@ -341,6 +396,9 @@ subroutine ADI_PackIW_InputData(RF, Indata) call NWTC_Library_PackFileInfoType(RF, InData%PassedFileInfo) call InflowWind_PackInputFile(RF, InData%PassedFileData) call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%MSL2SWL) + call RegPack(RF, InData%RootName) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -359,6 +417,9 @@ subroutine ADI_UnPackIW_InputData(RF, OutData) call NWTC_Library_UnpackFileInfoType(RF, OutData%PassedFileInfo) ! PassedFileInfo call InflowWind_UnpackInputFile(RF, OutData%PassedFileData) ! PassedFileData call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ADI_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -1346,6 +1407,115 @@ subroutine ADI_UnPackData(RF, OutData) call RegUnpackAlloc(RF, OutData%inputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine +subroutine ADI_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, CtrlCode, ErrStat, ErrMsg) + type(SeaState_Data), intent(in) :: SrcSeaState_DataData + type(SeaState_Data), intent(inout) :: DstSeaState_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopySeaState_Data' + ErrStat = ErrID_None + ErrMsg = '' + call SeaSt_CopyContState(SrcSeaState_DataData%x, DstSeaState_DataData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyDiscState(SrcSeaState_DataData%xd, DstSeaState_DataData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyConstrState(SrcSeaState_DataData%z, DstSeaState_DataData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyOtherState(SrcSeaState_DataData%OtherState, DstSeaState_DataData%OtherState, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyParam(SrcSeaState_DataData%p, DstSeaState_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyInput(SrcSeaState_DataData%u, DstSeaState_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyOutput(SrcSeaState_DataData%y, DstSeaState_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyMisc(SrcSeaState_DataData%m, DstSeaState_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyInitInput(SrcSeaState_DataData%InitInp, DstSeaState_DataData%InitInp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyInitOutput(SrcSeaState_DataData%InitOut, DstSeaState_DataData%InitOut, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine ADI_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) + type(SeaState_Data), intent(inout) :: SeaState_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroySeaState_Data' + ErrStat = ErrID_None + ErrMsg = '' + call SeaSt_DestroyContState(SeaState_DataData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyDiscState(SeaState_DataData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyConstrState(SeaState_DataData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyOtherState(SeaState_DataData%OtherState, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyParam(SeaState_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyInput(SeaState_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyOutput(SeaState_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyMisc(SeaState_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyInitInput(SeaState_DataData%InitInp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyInitOutput(SeaState_DataData%InitOut, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADI_PackSeaState_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaState_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackSeaState_Data' + if (RF%ErrStat >= AbortErrLev) return + call SeaSt_PackContState(RF, InData%x) + call SeaSt_PackDiscState(RF, InData%xd) + call SeaSt_PackConstrState(RF, InData%z) + call SeaSt_PackOtherState(RF, InData%OtherState) + call SeaSt_PackParam(RF, InData%p) + call SeaSt_PackInput(RF, InData%u) + call SeaSt_PackOutput(RF, InData%y) + call SeaSt_PackMisc(RF, InData%m) + call SeaSt_PackInitInput(RF, InData%InitInp) + call SeaSt_PackInitOutput(RF, InData%InitOut) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_UnPackSeaState_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaState_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackSeaState_Data' + if (RF%ErrStat /= ErrID_None) return + call SeaSt_UnpackContState(RF, OutData%x) ! x + call SeaSt_UnpackDiscState(RF, OutData%xd) ! xd + call SeaSt_UnpackConstrState(RF, OutData%z) ! z + call SeaSt_UnpackOtherState(RF, OutData%OtherState) ! OtherState + call SeaSt_UnpackParam(RF, OutData%p) ! p + call SeaSt_UnpackInput(RF, OutData%u) ! u + call SeaSt_UnpackOutput(RF, OutData%y) ! y + call SeaSt_UnpackMisc(RF, OutData%m) ! m + call SeaSt_UnpackInitInput(RF, OutData%InitInp) ! InitInp + call SeaSt_UnpackInitOutput(RF, OutData%InitOut) ! InitOut +end subroutine + subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMsg) type(RotFED), intent(inout) :: SrcRotFEDData type(RotFED), intent(inout) :: DstRotFEDData @@ -1757,5 +1927,495 @@ subroutine ADI_UnPackFED_Data(RF, OutData) end do end if end subroutine + +function ADI_InputMeshPointer(u, DL) result(Mesh) + type(ADI_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (ADI_u_AD_rotors_NacelleMotion) + Mesh => u%AD%rotors(DL%i1)%NacelleMotion + case (ADI_u_AD_rotors_TowerMotion) + Mesh => u%AD%rotors(DL%i1)%TowerMotion + case (ADI_u_AD_rotors_HubMotion) + Mesh => u%AD%rotors(DL%i1)%HubMotion + case (ADI_u_AD_rotors_BladeRootMotion) + Mesh => u%AD%rotors(DL%i1)%BladeRootMotion(DL%i2) + case (ADI_u_AD_rotors_BladeMotion) + Mesh => u%AD%rotors(DL%i1)%BladeMotion(DL%i2) + case (ADI_u_AD_rotors_TFinMotion) + Mesh => u%AD%rotors(DL%i1)%TFinMotion + end select +end function + +function ADI_OutputMeshPointer(y, DL) result(Mesh) + type(ADI_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (ADI_y_AD_rotors_NacelleLoad) + Mesh => y%AD%rotors(DL%i1)%NacelleLoad + case (ADI_y_AD_rotors_HubLoad) + Mesh => y%AD%rotors(DL%i1)%HubLoad + case (ADI_y_AD_rotors_TowerLoad) + Mesh => y%AD%rotors(DL%i1)%TowerLoad + case (ADI_y_AD_rotors_BladeLoad) + Mesh => y%AD%rotors(DL%i1)%BladeLoad(DL%i2) + case (ADI_y_AD_rotors_TFinLoad) + Mesh => y%AD%rotors(DL%i1)%TFinLoad + end select +end function + +subroutine ADI_VarsPackContState(Vars, x, ValAry) + type(ADI_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call ADI_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine ADI_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(ADI_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADI_x_AD_rotors_BEMT_UA_element_x) + VarVals = x%AD%rotors(DL%i1)%BEMT%UA%element(DL%i2, DL%i3)%x(V%iLB:V%iUB) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind) + VarVals = x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind(V%iLB:V%iUB) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind_1) + VarVals = x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind_1(V%iLB:V%iUB) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_V_w) + VarVals = x%AD%rotors(DL%i1)%BEMT%V_w(V%iLB:V%iUB) ! Rank 1 Array + case (ADI_x_AD_rotors_AA_DummyContState) + VarVals(1) = x%AD%rotors(DL%i1)%AA%DummyContState ! Scalar + case (ADI_x_AD_FVW_W_Gamma_NW) + VarVals = x%AD%FVW%W(DL%i1)%Gamma_NW(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (ADI_x_AD_FVW_W_Gamma_FW) + VarVals = x%AD%FVW%W(DL%i1)%Gamma_FW(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (ADI_x_AD_FVW_W_Eps_NW) + VarVals = x%AD%FVW%W(DL%i1)%Eps_NW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (ADI_x_AD_FVW_W_Eps_FW) + VarVals = x%AD%FVW%W(DL%i1)%Eps_FW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_NW) + VarVals = x%AD%FVW%W(DL%i1)%r_NW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_FW) + VarVals = x%AD%FVW%W(DL%i1)%r_FW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (ADI_x_AD_FVW_UA_element_x) + VarVals = x%AD%FVW%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADI_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ADI_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call ADI_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine ADI_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ADI_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADI_x_AD_rotors_BEMT_UA_element_x) + x%AD%rotors(DL%i1)%BEMT%UA%element(DL%i2, DL%i3)%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind) + x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind_1) + x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind_1(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_V_w) + x%AD%rotors(DL%i1)%BEMT%V_w(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ADI_x_AD_rotors_AA_DummyContState) + x%AD%rotors(DL%i1)%AA%DummyContState = VarVals(1) ! Scalar + case (ADI_x_AD_FVW_W_Gamma_NW) + x%AD%FVW%W(DL%i1)%Gamma_NW(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (ADI_x_AD_FVW_W_Gamma_FW) + x%AD%FVW%W(DL%i1)%Gamma_FW(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (ADI_x_AD_FVW_W_Eps_NW) + x%AD%FVW%W(DL%i1)%Eps_NW(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (ADI_x_AD_FVW_W_Eps_FW) + x%AD%FVW%W(DL%i1)%Eps_FW(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_NW) + x%AD%FVW%W(DL%i1)%r_NW(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_FW) + x%AD%FVW%W(DL%i1)%r_FW(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (ADI_x_AD_FVW_UA_element_x) + x%AD%FVW%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function ADI_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ADI_x_AD_rotors_BEMT_UA_element_x) + Name = "x%AD%rotors("//trim(Num2LStr(DL%i1))//")%BEMT%UA%element("//trim(Num2LStr(DL%i2))//", "//trim(Num2LStr(DL%i3))//")%x" + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind) + Name = "x%AD%rotors("//trim(Num2LStr(DL%i1))//")%BEMT%DBEMT%element("//trim(Num2LStr(DL%i2))//", "//trim(Num2LStr(DL%i3))//")%vind" + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind_1) + Name = "x%AD%rotors("//trim(Num2LStr(DL%i1))//")%BEMT%DBEMT%element("//trim(Num2LStr(DL%i2))//", "//trim(Num2LStr(DL%i3))//")%vind_1" + case (ADI_x_AD_rotors_BEMT_V_w) + Name = "x%AD%rotors("//trim(Num2LStr(DL%i1))//")%BEMT%V_w" + case (ADI_x_AD_rotors_AA_DummyContState) + Name = "x%AD%rotors("//trim(Num2LStr(DL%i1))//")%AA%DummyContState" + case (ADI_x_AD_FVW_W_Gamma_NW) + Name = "x%AD%FVW%W("//trim(Num2LStr(DL%i1))//")%Gamma_NW" + case (ADI_x_AD_FVW_W_Gamma_FW) + Name = "x%AD%FVW%W("//trim(Num2LStr(DL%i1))//")%Gamma_FW" + case (ADI_x_AD_FVW_W_Eps_NW) + Name = "x%AD%FVW%W("//trim(Num2LStr(DL%i1))//")%Eps_NW" + case (ADI_x_AD_FVW_W_Eps_FW) + Name = "x%AD%FVW%W("//trim(Num2LStr(DL%i1))//")%Eps_FW" + case (ADI_x_AD_FVW_W_r_NW) + Name = "x%AD%FVW%W("//trim(Num2LStr(DL%i1))//")%r_NW" + case (ADI_x_AD_FVW_W_r_FW) + Name = "x%AD%FVW%W("//trim(Num2LStr(DL%i1))//")%r_FW" + case (ADI_x_AD_FVW_UA_element_x) + Name = "x%AD%FVW%UA("//trim(Num2LStr(DL%i1))//")%element("//trim(Num2LStr(DL%i2))//", "//trim(Num2LStr(DL%i3))//")%x" + case default + Name = "Unknown Field" + end select +end function + +subroutine ADI_VarsPackContStateDeriv(Vars, x, ValAry) + type(ADI_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call ADI_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine ADI_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(ADI_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADI_x_AD_rotors_BEMT_UA_element_x) + VarVals = x%AD%rotors(DL%i1)%BEMT%UA%element(DL%i2, DL%i3)%x(V%iLB:V%iUB) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind) + VarVals = x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind(V%iLB:V%iUB) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_DBEMT_element_vind_1) + VarVals = x%AD%rotors(DL%i1)%BEMT%DBEMT%element(DL%i2, DL%i3)%vind_1(V%iLB:V%iUB) ! Rank 1 Array + case (ADI_x_AD_rotors_BEMT_V_w) + VarVals = x%AD%rotors(DL%i1)%BEMT%V_w(V%iLB:V%iUB) ! Rank 1 Array + case (ADI_x_AD_rotors_AA_DummyContState) + VarVals(1) = x%AD%rotors(DL%i1)%AA%DummyContState ! Scalar + case (ADI_x_AD_FVW_W_Gamma_NW) + VarVals = x%AD%FVW%W(DL%i1)%Gamma_NW(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (ADI_x_AD_FVW_W_Gamma_FW) + VarVals = x%AD%FVW%W(DL%i1)%Gamma_FW(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (ADI_x_AD_FVW_W_Eps_NW) + VarVals = x%AD%FVW%W(DL%i1)%Eps_NW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (ADI_x_AD_FVW_W_Eps_FW) + VarVals = x%AD%FVW%W(DL%i1)%Eps_FW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_NW) + VarVals = x%AD%FVW%W(DL%i1)%r_NW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (ADI_x_AD_FVW_W_r_FW) + VarVals = x%AD%FVW%W(DL%i1)%r_FW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (ADI_x_AD_FVW_UA_element_x) + VarVals = x%AD%FVW%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADI_VarsPackConstrState(Vars, z, ValAry) + type(ADI_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call ADI_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine ADI_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(ADI_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADI_z_AD_rotors_BEMT_phi) + VarVals = z%AD%rotors(DL%i1)%BEMT%phi(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (ADI_z_AD_rotors_AA_DummyConstrState) + VarVals(1) = z%AD%rotors(DL%i1)%AA%DummyConstrState ! Scalar + case (ADI_z_AD_FVW_W_Gamma_LL) + VarVals = z%AD%FVW%W(DL%i1)%Gamma_LL(V%iLB:V%iUB) ! Rank 1 Array + case (ADI_z_AD_FVW_residual) + VarVals(1) = z%AD%FVW%residual ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADI_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ADI_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call ADI_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine ADI_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ADI_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADI_z_AD_rotors_BEMT_phi) + z%AD%rotors(DL%i1)%BEMT%phi(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (ADI_z_AD_rotors_AA_DummyConstrState) + z%AD%rotors(DL%i1)%AA%DummyConstrState = VarVals(1) ! Scalar + case (ADI_z_AD_FVW_W_Gamma_LL) + z%AD%FVW%W(DL%i1)%Gamma_LL(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ADI_z_AD_FVW_residual) + z%AD%FVW%residual = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function ADI_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ADI_z_AD_rotors_BEMT_phi) + Name = "z%AD%rotors("//trim(Num2LStr(DL%i1))//")%BEMT%phi" + case (ADI_z_AD_rotors_AA_DummyConstrState) + Name = "z%AD%rotors("//trim(Num2LStr(DL%i1))//")%AA%DummyConstrState" + case (ADI_z_AD_FVW_W_Gamma_LL) + Name = "z%AD%FVW%W("//trim(Num2LStr(DL%i1))//")%Gamma_LL" + case (ADI_z_AD_FVW_residual) + Name = "z%AD%FVW%residual" + case default + Name = "Unknown Field" + end select +end function + +subroutine ADI_VarsPackInput(Vars, u, ValAry) + type(ADI_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call ADI_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine ADI_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(ADI_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADI_u_AD_rotors_NacelleMotion) + call MV_PackMesh(V, u%AD%rotors(DL%i1)%NacelleMotion, ValAry) ! Mesh + case (ADI_u_AD_rotors_TowerMotion) + call MV_PackMesh(V, u%AD%rotors(DL%i1)%TowerMotion, ValAry) ! Mesh + case (ADI_u_AD_rotors_HubMotion) + call MV_PackMesh(V, u%AD%rotors(DL%i1)%HubMotion, ValAry) ! Mesh + case (ADI_u_AD_rotors_BladeRootMotion) + call MV_PackMesh(V, u%AD%rotors(DL%i1)%BladeRootMotion(DL%i2), ValAry) ! Mesh + case (ADI_u_AD_rotors_BladeMotion) + call MV_PackMesh(V, u%AD%rotors(DL%i1)%BladeMotion(DL%i2), ValAry) ! Mesh + case (ADI_u_AD_rotors_TFinMotion) + call MV_PackMesh(V, u%AD%rotors(DL%i1)%TFinMotion, ValAry) ! Mesh + case (ADI_u_AD_rotors_UserProp) + VarVals = u%AD%rotors(DL%i1)%UserProp(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADI_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ADI_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call ADI_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine ADI_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ADI_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADI_u_AD_rotors_NacelleMotion) + call MV_UnpackMesh(V, ValAry, u%AD%rotors(DL%i1)%NacelleMotion) ! Mesh + case (ADI_u_AD_rotors_TowerMotion) + call MV_UnpackMesh(V, ValAry, u%AD%rotors(DL%i1)%TowerMotion) ! Mesh + case (ADI_u_AD_rotors_HubMotion) + call MV_UnpackMesh(V, ValAry, u%AD%rotors(DL%i1)%HubMotion) ! Mesh + case (ADI_u_AD_rotors_BladeRootMotion) + call MV_UnpackMesh(V, ValAry, u%AD%rotors(DL%i1)%BladeRootMotion(DL%i2)) ! Mesh + case (ADI_u_AD_rotors_BladeMotion) + call MV_UnpackMesh(V, ValAry, u%AD%rotors(DL%i1)%BladeMotion(DL%i2)) ! Mesh + case (ADI_u_AD_rotors_TFinMotion) + call MV_UnpackMesh(V, ValAry, u%AD%rotors(DL%i1)%TFinMotion) ! Mesh + case (ADI_u_AD_rotors_UserProp) + u%AD%rotors(DL%i1)%UserProp(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + +function ADI_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ADI_u_AD_rotors_NacelleMotion) + Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%NacelleMotion" + case (ADI_u_AD_rotors_TowerMotion) + Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%TowerMotion" + case (ADI_u_AD_rotors_HubMotion) + Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%HubMotion" + case (ADI_u_AD_rotors_BladeRootMotion) + Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%BladeRootMotion("//trim(Num2LStr(DL%i2))//")" + case (ADI_u_AD_rotors_BladeMotion) + Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%BladeMotion("//trim(Num2LStr(DL%i2))//")" + case (ADI_u_AD_rotors_TFinMotion) + Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%TFinMotion" + case (ADI_u_AD_rotors_UserProp) + Name = "u%AD%rotors("//trim(Num2LStr(DL%i1))//")%UserProp" + case default + Name = "Unknown Field" + end select +end function + +subroutine ADI_VarsPackOutput(Vars, y, ValAry) + type(ADI_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call ADI_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine ADI_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(ADI_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADI_y_AD_rotors_NacelleLoad) + call MV_PackMesh(V, y%AD%rotors(DL%i1)%NacelleLoad, ValAry) ! Mesh + case (ADI_y_AD_rotors_HubLoad) + call MV_PackMesh(V, y%AD%rotors(DL%i1)%HubLoad, ValAry) ! Mesh + case (ADI_y_AD_rotors_TowerLoad) + call MV_PackMesh(V, y%AD%rotors(DL%i1)%TowerLoad, ValAry) ! Mesh + case (ADI_y_AD_rotors_BladeLoad) + call MV_PackMesh(V, y%AD%rotors(DL%i1)%BladeLoad(DL%i2), ValAry) ! Mesh + case (ADI_y_AD_rotors_TFinLoad) + call MV_PackMesh(V, y%AD%rotors(DL%i1)%TFinLoad, ValAry) ! Mesh + case (ADI_y_AD_rotors_WriteOutput) + VarVals = y%AD%rotors(DL%i1)%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case (ADI_y_HHVel) + VarVals = y%HHVel(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (ADI_y_PLExp) + VarVals(1) = y%PLExp ! Scalar + case (ADI_y_IW_WriteOutput) + VarVals = y%IW_WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case (ADI_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ADI_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ADI_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call ADI_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine ADI_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ADI_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ADI_y_AD_rotors_NacelleLoad) + call MV_UnpackMesh(V, ValAry, y%AD%rotors(DL%i1)%NacelleLoad) ! Mesh + case (ADI_y_AD_rotors_HubLoad) + call MV_UnpackMesh(V, ValAry, y%AD%rotors(DL%i1)%HubLoad) ! Mesh + case (ADI_y_AD_rotors_TowerLoad) + call MV_UnpackMesh(V, ValAry, y%AD%rotors(DL%i1)%TowerLoad) ! Mesh + case (ADI_y_AD_rotors_BladeLoad) + call MV_UnpackMesh(V, ValAry, y%AD%rotors(DL%i1)%BladeLoad(DL%i2)) ! Mesh + case (ADI_y_AD_rotors_TFinLoad) + call MV_UnpackMesh(V, ValAry, y%AD%rotors(DL%i1)%TFinLoad) ! Mesh + case (ADI_y_AD_rotors_WriteOutput) + y%AD%rotors(DL%i1)%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ADI_y_HHVel) + y%HHVel(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (ADI_y_PLExp) + y%PLExp = VarVals(1) ! Scalar + case (ADI_y_IW_WriteOutput) + y%IW_WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ADI_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function ADI_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ADI_y_AD_rotors_NacelleLoad) + Name = "y%AD%rotors("//trim(Num2LStr(DL%i1))//")%NacelleLoad" + case (ADI_y_AD_rotors_HubLoad) + Name = "y%AD%rotors("//trim(Num2LStr(DL%i1))//")%HubLoad" + case (ADI_y_AD_rotors_TowerLoad) + Name = "y%AD%rotors("//trim(Num2LStr(DL%i1))//")%TowerLoad" + case (ADI_y_AD_rotors_BladeLoad) + Name = "y%AD%rotors("//trim(Num2LStr(DL%i1))//")%BladeLoad("//trim(Num2LStr(DL%i2))//")" + case (ADI_y_AD_rotors_TFinLoad) + Name = "y%AD%rotors("//trim(Num2LStr(DL%i1))//")%TFinLoad" + case (ADI_y_AD_rotors_WriteOutput) + Name = "y%AD%rotors("//trim(Num2LStr(DL%i1))//")%WriteOutput" + case (ADI_y_HHVel) + Name = "y%HHVel" + case (ADI_y_PLExp) + Name = "y%PLExp" + case (ADI_y_IW_WriteOutput) + Name = "y%IW_WriteOutput" + case (ADI_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE AeroDyn_Inflow_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index 9060a08859..92e7c6791b 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -13,10 +13,11 @@ include Registry_NWTC_Library.txt usefrom AirfoilInfo_Registry.txt usefrom BEMT_Registry.txt -usefrom FVW_Registry.txt +usefrom FVW_Registry.txt usefrom UnsteadyAero_Registry.txt usefrom AeroAcoustics_Registry.txt usefrom InflowWind.txt +usefrom SeaSt_WaveField.txt param AeroDyn/AD - IntKi ModelUnknown - -1 - "" - param ^ - IntKi WakeMod_none - 0 - "Wake model - none" - @@ -52,6 +53,9 @@ param ^ - IntKi APM_LiftingLine - 3 - "Use the bl # if more than AD_MaxBl_Out blades are used in the simulation, not all channels will have output information for the "extra" blades. # Also, the AD input file will require more lines for the additional blades. param ^ - IntKi AD_MaxBl_Out - 3 - "Maximum number of blades for information output (or linearization)" - +param ^ - IntKi AD_u_HWindSpeed - -1 - "DatLoc number for HWindSpeed extended input" - +param ^ - IntKi AD_u_PLExp - -2 - "DatLoc number for PLExp extended input" - +param ^ - IntKi AD_u_PropagationDir - -3 - "DatLoc number for PropagationDir extended input" - # Tail Fin parameters typedef ^ TFinParameterType IntKi TFinMod - - 0 "Tail fin aerodynamics model {0=none, 1=polar-based, 2=USB-based}" (switch) @@ -110,6 +114,7 @@ typedef ^ InitInputType Logical Linearize - .FALSE. - "Flag that tells this modu typedef ^ InitInputType LOGICAL CompAeroMaps - .FALSE. - "flag to determine if AeroDyn is computing aero maps (true) or running a normal simulation (false)" - typedef ^ InitInputType ReKi Gravity - - - "Gravity force" Nm/s^2 typedef ^ InitInputType IntKi MHK - - - "MHK turbine type switch" - +typedef ^ InitInputType LOGICAL CompSeaSt - - - "Flag to indicate whether SeaState is selected" - typedef ^ InitInputType ReKi defFldDens - - - "Default fluid density from the driver; may be overwritten" kg/m^3 typedef ^ InitInputType ReKi defKinVisc - - - "Default kinematic viscosity from the driver; may be overwritten" m^2/s typedef ^ InitInputType ReKi defSpdSound - - - "Default speed of sound from the driver; may be overwritten" m/s @@ -129,14 +134,21 @@ typedef ^ AD_BladePropsType ReKi BlCrvAng {:} - - "Curve angle at blade node" ra typedef ^ AD_BladePropsType ReKi BlTwist {:} - - "Twist at blade node" radians typedef ^ AD_BladePropsType ReKi BlChord {:} - - "Chord at blade node" m typedef ^ AD_BladePropsType IntKi BlAFID {:} - - "ID of Airfoil at blade node" - +typedef ^ AD_BladePropsType ReKi t_c {:} - - "Thickness to chord ratio at blade node" - typedef ^ AD_BladePropsType ReKi BlCb {:} - - "Coefficient of buoyancy at blade node" - typedef ^ AD_BladePropsType ReKi BlCenBn {:} - - "Center of buoyancy normal offset at blade node" m typedef ^ AD_BladePropsType ReKi BlCenBt {:} - - "Center of buoyancy tangential offset at blade node" m +typedef ^ AD_BladePropsType ReKi BlCpn {:} - - "Chordwise coefficient of dynamic pressure at blade node" - +typedef ^ AD_BladePropsType ReKi BlCpt {:} - - "Edgewise coefficient of dynamic pressure at blade node" - +typedef ^ AD_BladePropsType ReKi BlCan {:} - - "Chordwise coefficient of added mass at blade node" - +typedef ^ AD_BladePropsType ReKi BlCat {:} - - "Edgewise coefficient of added mass at blade node" - +typedef ^ AD_BladePropsType ReKi BlCam {:} - - "Pitch coefficient of added mass at blade node" - # Define outputs from the initialization routine here: typedef ^ AD_BladeShape SiKi AirfoilCoords {:}{:}{:} - - "x-y coordinates for airfoils, relative to node" m # Define outputs from the initialization routine here: +typedef ^ RotInitOutputType ModVarsType *Vars - - - "Module Variables" typedef ^ RotInitOutputType ReKi AirDens - - - "Air density" kg/m^3 typedef ^ RotInitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - typedef ^ RotInitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - @@ -167,6 +179,8 @@ typedef ^ RotInputFile ReKi TwrDiam {:} - - "Diameter of tower at node" m typedef ^ RotInputFile ReKi TwrCd {:} - - "Coefficient of drag at tower node" - typedef ^ RotInputFile ReKi TwrTI {:} - - "Turbulence intensity for tower shadow at tower node" - typedef ^ RotInputFile ReKi TwrCb {:} - - "Coefficient of buoyancy at tower node" - +typedef ^ RotInputFile ReKi TwrCp {:} - - "Coefficient of dynamic pressure at tower node" - +typedef ^ RotInputFile ReKi TwrCa {:} - - "Coefficient of added mass at tower node" - # Hub typedef ^ RotInputFile ReKi VolHub - - - "Hub volume" m^3 typedef ^ RotInputFile ReKi HubCenBx - - - "Hub center of buoyancy x direction offset" m @@ -189,7 +203,6 @@ typedef ^ AD_InputFile IntKi TwrPotent - - - "Type of tower influence on wind ba typedef ^ AD_InputFile IntKi TwrShadow - - - "Type of tower influence on wind based on downstream tower shadow {0=none, 1=Powles model, 2=Eames model}" - typedef ^ AD_InputFile IntKi TwrAero - - - "Calculate tower aerodynamic loads? {0=none, 1=aero without VIV, 2=aero with VIV}" - typedef ^ AD_InputFile Logical CavitCheck - - - "Flag that tells us if we want to check for cavitation" - -typedef ^ AD_InputFile Logical Buoyancy - - - "Include buoyancy effects?" flag typedef ^ AD_InputFile Logical NacelleDrag - - - "Include NacelleDrag effects?" flag typedef ^ AD_InputFile Logical CompAA - - - "Compute AeroAcoustic noise" flag typedef ^ AD_InputFile CHARACTER(1024) AA_InputFile - - - "AeroAcoustics input file name" "quoted strings" @@ -281,76 +294,6 @@ typedef ^ OtherStateType RotOtherStateType rotors {:} - - "OtherStates from the typedef ^ OtherStateType FVW_OtherStateType FVW - - - "OtherStates from the FVW module" - typedef ^ OtherStateType ReKi WakeLocationPoints {:}{:} - - "wake points velocity" m/s - -# Define misc/optimization variables (any data that are not considered actual states) here: -typedef ^ RotMiscVarType BEMT_MiscVarType BEMT - - - "MiscVars from the BEMT module" - -typedef ^ RotMiscVarType BEMT_OutputType BEMT_y - - - "Outputs from the BEMT module" - -typedef ^ RotMiscVarType BEMT_InputType BEMT_u 2 - - "Inputs to the BEMT module" - -typedef ^ RotMiscVarType AA_MiscVarType AA - - - "MiscVars from the AA module" - -typedef ^ RotMiscVarType AA_OutputType AA_y - - - "Outputs from the AA module" - -typedef ^ RotMiscVarType AA_InputType AA_u - - - "Inputs to the AA module" - - -typedef ^ RotMiscVarType ReKi DisturbedInflow {:}{:}{:} - - "InflowOnBlade values modified by tower influence" m/s -typedef ^ RotMiscVarType ReKi SectAvgInflow {:}{:}{:} - - "Sector averaged - disturbed inflow to improve BEM shear calculations" m/s -typedef ^ RotMiscVarType R8Ki orientationAnnulus {:}{:}{:}{:} - - "Coordinate system equivalent to BladeMotion Orientation, but without live sweep, blade-pitch, and twist angles" - -typedef ^ RotMiscVarType R8Ki R_li {:}{:}{:}{:} - - "Transformation matrix from inertial system to the staggered polar coordinate system of a given section" - -typedef ^ RotMiscVarType ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" - -typedef ^ RotMiscVarType ReKi W_Twr {:} - - "relative wind speed normal to the tower at node j" m/s -typedef ^ RotMiscVarType ReKi X_Twr {:} - - "local x-component of force per unit length of the jth node in the tower" m/s -typedef ^ RotMiscVarType ReKi Y_Twr {:} - - "local y-component of force per unit length of the jth node in the tower" m/s -typedef ^ RotMiscVarType ReKi Cant {:}{:} - - "curvature angle, saved for possible output to file" rad -typedef ^ RotMiscVarType ReKi Toe {:}{:} - - "Toe angle, saved for possible output to file" rad -typedef ^ RotMiscVarType ReKi TwrClrnc {:}{:} - - "Distance between tower (including tower radius) and blade node (not including blade width), saved for possible output to file" m -typedef ^ RotMiscVarType ReKi X {:}{:} - - "normal force per unit length (normal to the plane, not chord) of the jth node in the kth blade" N/m -typedef ^ RotMiscVarType ReKi Y {:}{:} - - "tangential force per unit length (tangential to the plane, not chord) of the jth node in the kth blade" N/m -typedef ^ RotMiscVarType ReKi Z {:}{:} - - "axial force per unit length (tangential to the plane, not chord) of the jth node in the kth blade" N/m -typedef ^ RotMiscVarType ReKi M {:}{:} - - "pitching moment per unit length of the jth node in the kth blade" Nm/m -typedef ^ RotMiscVarType ReKi Mx {:}{:} - - "pitching moment per unit length of the jth node in the kth blade (in x direction)" Nm/m -typedef ^ RotMiscVarType ReKi My {:}{:} - - "pitching moment per unit length of the jth node in the kth blade (in y direction)" Nm/m -typedef ^ RotMiscVarType ReKi Mz {:}{:} - - "pitching moment per unit length of the jth node in the kth blade (in z direction)" Nm/m -typedef ^ RotMiscVarType ReKi Vind_i {:}{:}{:} - - "Induced velocities at jth node and kth blade (3xnSpanxnB)" m/s -typedef ^ RotMiscVarType ReKi V_DiskAvg {3} - - "disk-average relative wind speed" m/s -typedef ^ RotMiscVarType ReKi yaw - - - "Yaw calculated in SetInputsForBEMT" rad -typedef ^ RotMiscVarType ReKi tilt - - - "tilt calculated in SetInputsForBEMT" rad -typedef ^ RotMiscVarType ReKi hub_theta_x_root {:} - - "angles saved for FAST.Farm" rad -typedef ^ RotMiscVarType ReKi V_dot_x - - - -typedef ^ RotMiscVarType MeshType HubLoad - - - "mesh at hub; used to compute an integral for mapping the output blade loads to a single point (for writing to file only)" - -typedef ^ RotMiscVarType MeshMapType B_L_2_H_P {:} - - "mapping data structure to map each bladeLoad output mesh to the MiscVar%HubLoad mesh" -typedef ^ RotMiscVarType ReKi SigmaCavitCrit {:}{:} - - "critical cavitation number- inception value (above which cavit will occur)" - -typedef ^ RotMiscVarType ReKi SigmaCavit {:}{:} - - "cavitation number at node " - -typedef ^ RotMiscVarType Logical CavitWarnSet {:}{:} - - "cavitation warning issued " - -typedef ^ RotMiscVarType ReKi TwrFB {:}{:} - - "buoyant force per unit length at tower node" N/m -typedef ^ RotMiscVarType ReKi TwrMB {:}{:} - - "buoyant moment per unit length at tower node" Nm/m -typedef ^ RotMiscVarType ReKi HubFB {:} - - "buoyant force at hub node" N -typedef ^ RotMiscVarType ReKi HubMB {:} - - "buoyant moment at hub node" Nm -typedef ^ RotMiscVarType ReKi NacFB {:} - - "buoyant force at nacelle (tower top) node" N -typedef ^ RotMiscVarType ReKi NacMB {:} - - "buoyant moment at nacelle (tower top) node" Nm -typedef ^ RotMiscVarType ReKi NacDragF {:} - - "drag force at nacelle (tower top) node" N -typedef ^ RotMiscVarType ReKi NacDragM {:} - - "drag moment at nacelle (tower top) node" Nm -typedef ^ RotMiscVarType ReKi NacFi {:} - - "Total force at nacelle (tower top) node" N -typedef ^ RotMiscVarType ReKi NacMi {:} - - "Total moment at nacelle (tower top) node" Nm -typedef ^ RotMiscVarType MeshType BladeRootLoad {:} - - "meshes at blade root; used to compute an integral for mapping the output blade loads to single points (for writing to file only)" - -typedef ^ RotMiscVarType MeshMapType B_L_2_R_P {:} - - "mapping data structure to map each bladeLoad output mesh to corresponding MiscVar%BladeRootLoad mesh" -typedef ^ RotMiscVarType MeshType BladeBuoyLoadPoint {:} - - "point mesh for lumped buoyant blade loads" - -typedef ^ RotMiscVarType MeshType BladeBuoyLoad {:} - - "line mesh for per unit length buoyant blade loads" - -typedef ^ RotMiscVarType MeshMapType B_P_2_B_L {:} - - "mapping data structure to map buoyant blade point loads (m%BladeBuoyLoadPoint) to buoyant blade line loads (m%BladeBuoyLoad)" -typedef ^ RotMiscVarType MeshType TwrBuoyLoadPoint - - - "point mesh for lumped buoyant tower loads" - -typedef ^ RotMiscVarType MeshType TwrBuoyLoad - - - "line mesh for per unit length buoyant tower loads" - -typedef ^ RotMiscVarType MeshMapType T_P_2_T_L - - - "mapping data structure to map buoyant tower point loads (m%TwrBuoyLoadPoint) to buoyant tower line loads (m%TwrBuoyLoad)" -typedef ^ RotMiscVarType Logical FirstWarn_TowerStrike - - - "flag to avoid printing tower strike multiple times" - -typedef ^ RotMiscVarType ReKi AvgDiskVel {3} - - "disk-averaged U,V,W (undisturbed)" m/s -typedef ^ RotMiscVarType ReKi AvgDiskVelDist {3} - - "disk-averaged U,V,W (disturbed)" m/s -# TailFin -typedef ^ RotMiscVarType ReKi TFinAlpha - - - "Angle of attack for tailfin" -typedef ^ RotMiscVarType ReKi TFinRe - - - "Reynolds number for tailfin" -typedef ^ RotMiscVarType ReKi TFinVrel - - - "Orthogonal relative velocity nrom at the reference point" -typedef ^ RotMiscVarType ReKi TFinVund_i 3 - - "Undisturbed wind velocity at the reference point of the fin in the inertial system" -typedef ^ RotMiscVarType ReKi TFinVind_i 3 - - "Induced velocity at the reference point of the fin in the inertial system" -typedef ^ RotMiscVarType ReKi TFinVrel_i 3 - - "Relative velocity at the reference point of the fin in the inertial system" -typedef ^ RotMiscVarType ReKi TFinSTV_i 3 - - "Structural velocity at the reference point of the fin in the inertial system" -typedef ^ RotMiscVarType ReKi TFinF_i 3 - - "Forces at the reference point of the fin in the inertial system" -typedef ^ RotMiscVarType ReKi TFinM_i 3 - - "Moments at the reference point of the fin in the inertial system" - # Inflow data storage typedef ^ ElemInflowType ReKi InflowVel {:}{:} - - "U,V,W at nodes on element (note if we change the requirement that NumNodes is the same for each blade, this will need to change)" m/s typedef ^ ElemInflowType ReKi InflowAcc {:}{:} - - "Wind acceleration at nodes on element (blade or tower) (note if we change the requirement that NumNodes is the same for each blade, this will need to change)" m/s @@ -364,34 +307,13 @@ typedef ^ RotInflowType ReKi AvgDiskVel {3} - 0.0 "disk-averaged U,V,W" m/s typedef ^ AD_InflowType ReKi InflowWakeVel {:}{:} - - "U,V,W at wake points" m/s typedef ^ AD_InflowType RotInflowType RotInflow {:} - - "Inflow on rotor" - -typedef ^ MiscVarType RotMiscVarType rotors {:} - - "MiscVars for each rotor" - -typedef ^ MiscVarType FVW_InputType FVW_u : - - "Inputs to the FVW module" - -typedef ^ MiscVarType FVW_OutputType FVW_y - - - "Outputs from the FVW module" - -typedef ^ MiscVarType FVW_MiscVarType FVW - - - "MiscVars from the FVW module" - -typedef ^ MiscVarType ReKi WindPos {:}{:} - - "XYZ coordinates to query for wind velocity/acceleration" - -typedef ^ MiscVarType ReKi WindVel {:}{:} - - "XYZ components of wind velocity" - -typedef ^ MiscVarType ReKi WindAcc {:}{:} - - "XYZ components of wind acceleration" - -typedef ^ MiscVarType AD_InflowType Inflow {:} - - "Inflow storage (size of u for history of inputs)" - - # ..... Parameters ................................................................................................................ # Define parameters here: # Parameters for each rotor -typedef ^ Jac_u_idxStarts IntKi Nacelle - 1 - "Index to first point in u jacobian for Nacelle" - -typedef ^ Jac_u_idxStarts IntKi Hub - 1 - "Index to first point in u jacobian for Hub" - -typedef ^ Jac_u_idxStarts IntKi TFin - 1 - "Index to first point in u jacobian for TFin" - -typedef ^ Jac_u_idxStarts IntKi Tower - 1 - "Index to first point in u jacobian for Tower" - -typedef ^ Jac_u_idxStarts IntKi BladeRoot - 1 - "Index to first point in u jacobian for BladeRoot" - -typedef ^ Jac_u_idxStarts IntKi Blade - 1 - "Index to first point in u jacobian for Blade" - -typedef ^ Jac_u_idxStarts IntKi UserProp - 1 - "Index to first point in u jacobian for UserProp" - -typedef ^ Jac_u_idxStarts IntKi Extended - 1 - "Index to first point in u jacobian for Extended" - -typedef ^ Jac_y_idxStarts IntKi NacelleLoad - 1 - "Index to first point in y jacobian for NacelleLoad" - -typedef ^ Jac_y_idxStarts IntKi HubLoad - 1 - "Index to first point in y jacobian for HubLoad" - -typedef ^ Jac_y_idxStarts IntKi TFinLoad - 1 - "Index to first point in y jacobian for TFinLoad" - -typedef ^ Jac_y_idxStarts IntKi TowerLoad - 1 - "Index to first point in y jacobian for TowerLoad" - -typedef ^ Jac_y_idxStarts IntKi BladeLoad - 1 - "Index to first point in y jacobian for BladeLoad" - +typedef ^ RotParameterType ModVarsType &Vars - - - "Module Variables" typedef ^ RotParameterType IntKi NumBlades - - - "Number of blades on the turbine" - typedef ^ RotParameterType IntKi NumBlNds - - - "Number of nodes on each blade" - typedef ^ RotParameterType IntKi NumTwrNds - - - "Number of nodes on the tower" - @@ -400,6 +322,8 @@ typedef ^ RotParameterType ReKi TwrCd {:} - - "Coefficient of drag at tower node typedef ^ RotParameterType ReKi TwrTI {:} - - "Turbulence intensity for tower shadow at tower node" - typedef ^ ^ ReKi BlTwist {:}{:} - - "Twist at blade node" radians typedef ^ RotParameterType ReKi TwrCb {:} - - "Coefficient of buoyancy at tower node" - +typedef ^ RotParameterType ReKi TwrCp {:} - - "Coefficient of dynamic pressure at tower node" - +typedef ^ RotParameterType ReKi TwrCa {:} - - "Coefficient of added mass at tower node" - typedef ^ RotParameterType ReKi BlCenBn {:}{:} - - "Normal offset between aerodynamic center and center of buoyancy at blade node" m typedef ^ RotParameterType ReKi BlCenBt {:}{:} - - "Tangential offset between aerodynamic center and center of buoyancy at blade node" m typedef ^ RotParameterType ReKi VolHub - - - "Hub volume" m^3 @@ -415,15 +339,19 @@ typedef ^ RotParameterType ReKi BlRad {:}{:} - - "Matrix of equivalent bla typedef ^ RotParameterType ReKi BlDL {:}{:} - - "Matrix of blade element length based on CB, used in buoyancy calculation" m typedef ^ RotParameterType ReKi BlTaper {:}{:} - - "Matrix of blade element taper, used in buoyancy calculation" - typedef ^ RotParameterType ReKi BlAxCent {:}{:} - - "Matrix of blade element axial centroid, used in buoyancy calculation" - +typedef ^ RotParameterType ReKi BlIN {:}{:} - - "Matrix of blade node normal-to-chord inertia factor" kg/m +typedef ^ RotParameterType ReKi BlIT {:}{:} - - "Matrix of blade node tangential-to-chord inertia factor" kg/m +typedef ^ RotParameterType ReKi BlAN {:}{:} - - "Matrix of blade node normal-to-chord added mass factor" kg/m +typedef ^ RotParameterType ReKi BlAT {:}{:} - - "Matrix of blade node tangential-to-chord added mass factor" kg/m +typedef ^ RotParameterType ReKi BlAM {:}{:} - - "Matrix of blade node pitch added mass factor" kgm typedef ^ RotParameterType ReKi TwrRad {:} - - "Array of equivalent tower radius at each node, used in buoyancy calculation" m typedef ^ RotParameterType ReKi TwrDL {:} - - "Array of tower element length, used in buoyancy calculation" m typedef ^ RotParameterType ReKi TwrTaper {:} - - "Array of tower element taper, used in buoyancy calculation" - typedef ^ RotParameterType ReKi TwrAxCent {:} - - "Array of tower element axial centroid, used in buoyancy calculation" - +typedef ^ RotParameterType ReKi TwrIT {:} - - "Array of tower node tangential inertia factor" kg/m +typedef ^ RotParameterType ReKi TwrAT {:} - - "Array of tower node tangential added mass factor" kg/m typedef ^ RotParameterType BEMT_ParameterType BEMT - - - "Parameters for BEMT module" typedef ^ RotParameterType AA_ParameterType AA - - - "Parameters for AA module" -typedef ^ RotParameterType IntKi Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - -typedef ^ RotParameterType Jac_u_idxStarts Jac_u_idxStartList - - - "Starting indices for all Jac_u components" - -typedef ^ RotParameterType Jac_y_idxStarts Jac_y_idxStartList - - - "Starting indices for all Jac_y components" - typedef ^ RotParameterType IntKi NumExtendedInputs - - - "number of extended inputs" - typedef ^ RotParameterType ReKi du {:} - - "vector that determines size of perturbation for u (inputs)" typedef ^ RotParameterType ReKi dx {:} - - "vector that determines size of perturbation for x (continuous states)" @@ -435,7 +363,6 @@ typedef ^ RotParameterType IntKi TwrShadow - - - "Type of tower influence on win typedef ^ RotParameterType IntKi TwrAero - - - "Calculate tower aerodynamic loads? {0=none, 1=aero without VIV, 2=aero with VIV}" switch typedef ^ RotParameterType Integer DBEMT_Mod - - - "DBEMT_Mod" - typedef ^ RotParameterType Logical CavitCheck - - - "Flag that tells us if we want to check for cavitation" - -typedef ^ RotParameterType Logical Buoyancy - - - "Include buoyancy effects?" flag typedef ^ RotParameterType Logical NacelleDrag - - - "Include NacelleDrag effects?" flag typedef ^ RotParameterType IntKi MHK - - - "MHK" flag typedef ^ RotParameterType Logical CompAA - - - "Compute AeroAcoustic noise" flag @@ -479,13 +406,14 @@ typedef ^ ParameterType IntKi Wake_Mod - - - "Type of wake/induction model {0=no typedef ^ ParameterType FVW_ParameterType FVW - - - "Parameters for FVW module" typedef ^ ParameterType LOGICAL CompAeroMaps - .FALSE. - "flag to determine if AeroDyn is computing aero maps (true) or running a normal simulation (false)" - typedef ^ ParameterType LOGICAL UA_Flag - - - "logical flag indicating whether to use UnsteadyAero" - +typedef ^ ParameterType LOGICAL CompSeaSt - - - "Flag to indicate whether SeaState is selected" - typedef ^ ParameterType FlowFieldType *FlowField - - - "Pointer of InflowWinds flow field data type" - typedef ^ ^ Logical SectAvg - - - "Use Sector average for BEM inflow velocity calculation" - typedef ^ ^ IntKi SA_Weighting - - 1 "Sector Average - Weighting function for sector average {1=Uniform, 2=Impulse} within a 360/nB sector centered on the blade (switch) [used only when SectAvg=True]" - typedef ^ ^ ReKi SA_PsiBwd - - - "Sector Average - Backard Azimuth (<0)" deg typedef ^ ^ ReKi SA_PsiFwd - - - "Sector Average - Forward Azimuth (>0)" deg typedef ^ ^ IntKi SA_nPerSec - - - "Sector Average - Number of points per sector (>1)" - - +typedef ^ ParameterType SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field data type" - # ..... Inputs .................................................................................................................... # Define inputs that are contained on a mesh here: @@ -514,3 +442,97 @@ typedef ^ RotOutputType ReKi WriteOutput {:} - - "Data to be written to an outpu typedef ^ OutputType RotOutputType rotors {:} - - "Ouputs for each rotor" - + +# Define misc/optimization variables (any data that are not considered actual states) here: +typedef ^ RotMiscVarType ModJacType Jac - - - "Values corresponding to module variables" +typedef ^ RotMiscVarType RotContinuousStateType x_init - - - "" - +typedef ^ RotMiscVarType RotContinuousStateType x_perturb - - - "" - +typedef ^ RotMiscVarType RotContinuousStateType dxdt_lin - - - "" - +typedef ^ RotMiscVarType RotInputType u_perturb - - - "" - +typedef ^ RotMiscVarType RotOutputType y_lin - - - "" - +typedef ^ RotMiscVarType RotConstraintStateType z_lin - - - "" - +typedef ^ RotMiscVarType RotOtherStateType OtherState_init - - - "" - +typedef ^ RotMiscVarType RotOtherStateType OtherState_jac - - - "" - + +typedef ^ RotMiscVarType BEMT_MiscVarType BEMT - - - "MiscVars from the BEMT module" - +typedef ^ RotMiscVarType BEMT_OutputType BEMT_y - - - "Outputs from the BEMT module" - +typedef ^ RotMiscVarType BEMT_InputType BEMT_u 2 - - "Inputs to the BEMT module" - +typedef ^ RotMiscVarType AA_MiscVarType AA - - - "MiscVars from the AA module" - +typedef ^ RotMiscVarType AA_OutputType AA_y - - - "Outputs from the AA module" - +typedef ^ RotMiscVarType AA_InputType AA_u - - - "Inputs to the AA module" - + +typedef ^ RotMiscVarType ReKi DisturbedInflow {:}{:}{:} - - "InflowOnBlade values modified by tower influence" m/s +typedef ^ RotMiscVarType ReKi SectAvgInflow {:}{:}{:} - - "Sector averaged - disturbed inflow to improve BEM shear calculations" m/s +typedef ^ RotMiscVarType R8Ki orientationAnnulus {:}{:}{:}{:} - - "Coordinate system equivalent to BladeMotion Orientation, but without live sweep, blade-pitch, and twist angles" - +typedef ^ RotMiscVarType R8Ki R_li {:}{:}{:}{:} - - "Transformation matrix from inertial system to the staggered polar coordinate system of a given section" - +typedef ^ RotMiscVarType ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" - +typedef ^ RotMiscVarType ReKi W_Twr {:} - - "relative wind speed normal to the tower at node j" m/s +typedef ^ RotMiscVarType ReKi X_Twr {:} - - "local x-component of force per unit length of the jth node in the tower" m/s +typedef ^ RotMiscVarType ReKi Y_Twr {:} - - "local y-component of force per unit length of the jth node in the tower" m/s +typedef ^ RotMiscVarType ReKi Cant {:}{:} - - "curvature angle, saved for possible output to file" rad +typedef ^ RotMiscVarType ReKi Toe {:}{:} - - "Toe angle, saved for possible output to file" rad +typedef ^ RotMiscVarType ReKi TwrClrnc {:}{:} - - "Distance between tower (including tower radius) and blade node (not including blade width), saved for possible output to file" m +typedef ^ RotMiscVarType ReKi X {:}{:} - - "normal force per unit length (normal to the plane, not chord) of the jth node in the kth blade" N/m +typedef ^ RotMiscVarType ReKi Y {:}{:} - - "tangential force per unit length (tangential to the plane, not chord) of the jth node in the kth blade" N/m +typedef ^ RotMiscVarType ReKi Z {:}{:} - - "axial force per unit length (tangential to the plane, not chord) of the jth node in the kth blade" N/m +typedef ^ RotMiscVarType ReKi M {:}{:} - - "pitching moment per unit length of the jth node in the kth blade" Nm/m +typedef ^ RotMiscVarType ReKi Mx {:}{:} - - "pitching moment per unit length of the jth node in the kth blade (in x direction)" Nm/m +typedef ^ RotMiscVarType ReKi My {:}{:} - - "pitching moment per unit length of the jth node in the kth blade (in y direction)" Nm/m +typedef ^ RotMiscVarType ReKi Mz {:}{:} - - "pitching moment per unit length of the jth node in the kth blade (in z direction)" Nm/m +typedef ^ RotMiscVarType ReKi Vind_i {:}{:}{:} - - "Induced velocities at jth node and kth blade (3xnSpanxnB)" m/s +typedef ^ RotMiscVarType ReKi V_DiskAvg {3} - - "disk-average relative wind speed" m/s +typedef ^ RotMiscVarType ReKi yaw - - - "Yaw calculated in SetInputsForBEMT" rad +typedef ^ RotMiscVarType ReKi tilt - - - "tilt calculated in SetInputsForBEMT" rad +typedef ^ RotMiscVarType ReKi hub_theta_x_root {:} - - "angles saved for FAST.Farm" rad +typedef ^ RotMiscVarType ReKi V_dot_x - - - +typedef ^ RotMiscVarType MeshType HubLoad - - - "mesh at hub; used to compute an integral for mapping the output blade loads to a single point (for writing to file only)" - +typedef ^ RotMiscVarType MeshMapType B_L_2_H_P {:} - - "mapping data structure to map each bladeLoad output mesh to the MiscVar%HubLoad mesh" +typedef ^ RotMiscVarType ReKi SigmaCavitCrit {:}{:} - - "critical cavitation number- inception value (above which cavit will occur)" - +typedef ^ RotMiscVarType ReKi SigmaCavit {:}{:} - - "cavitation number at node " - +typedef ^ RotMiscVarType Logical CavitWarnSet {:}{:} - - "cavitation warning issued " - +typedef ^ RotMiscVarType ReKi TwrFB {:}{:} - - "buoyant force per unit length at tower node" N/m +typedef ^ RotMiscVarType ReKi TwrMB {:}{:} - - "buoyant moment per unit length at tower node" Nm/m +typedef ^ RotMiscVarType ReKi HubFB {:} - - "buoyant force at hub node" N +typedef ^ RotMiscVarType ReKi HubMB {:} - - "buoyant moment at hub node" Nm +typedef ^ RotMiscVarType ReKi NacFB {:} - - "buoyant force at nacelle (tower top) node" N +typedef ^ RotMiscVarType ReKi NacMB {:} - - "buoyant moment at nacelle (tower top) node" Nm +typedef ^ RotMiscVarType ReKi NacDragF {:} - - "drag force at nacelle (tower top) node" N +typedef ^ RotMiscVarType ReKi NacDragM {:} - - "drag moment at nacelle (tower top) node" Nm +typedef ^ RotMiscVarType ReKi NacFi {:} - - "Total force at nacelle (tower top) node" N +typedef ^ RotMiscVarType ReKi NacMi {:} - - "Total moment at nacelle (tower top) node" Nm +typedef ^ RotMiscVarType ReKi BlFI {:}{:}{:} - - "inertia force per unit length at blade node" N/m +typedef ^ RotMiscVarType ReKi BlFA {:}{:}{:} - - "added mass force per unit length at blade node" N/m +typedef ^ RotMiscVarType ReKi BlMA {:}{:}{:} - - "added mass moment per unit length at blade node" N/m +typedef ^ RotMiscVarType ReKi TwrFI {:}{:} - - "inertia force per unit length at tower node" N/m +typedef ^ RotMiscVarType ReKi TwrFA {:}{:} - - "added mass force per unit length at tower node" N/m +typedef ^ RotMiscVarType MeshType BladeRootLoad {:} - - "meshes at blade root; used to compute an integral for mapping the output blade loads to single points (for writing to file only)" - +typedef ^ RotMiscVarType MeshMapType B_L_2_R_P {:} - - "mapping data structure to map each bladeLoad output mesh to corresponding MiscVar%BladeRootLoad mesh" +typedef ^ RotMiscVarType MeshType BladeBuoyLoadPoint {:} - - "point mesh for lumped buoyant blade loads" - +typedef ^ RotMiscVarType MeshType BladeBuoyLoad {:} - - "line mesh for per unit length buoyant blade loads" - +typedef ^ RotMiscVarType MeshMapType B_P_2_B_L {:} - - "mapping data structure to map buoyant blade point loads (m%BladeBuoyLoadPoint) to buoyant blade line loads (m%BladeBuoyLoad)" +typedef ^ RotMiscVarType MeshType TwrBuoyLoadPoint - - - "point mesh for lumped buoyant tower loads" - +typedef ^ RotMiscVarType MeshType TwrBuoyLoad - - - "line mesh for per unit length buoyant tower loads" - +typedef ^ RotMiscVarType MeshMapType T_P_2_T_L - - - "mapping data structure to map buoyant tower point loads (m%TwrBuoyLoadPoint) to buoyant tower line loads (m%TwrBuoyLoad)" +typedef ^ RotMiscVarType Logical FirstWarn_TowerStrike - - - "flag to avoid printing tower strike multiple times" - +typedef ^ RotMiscVarType ReKi AvgDiskVel {3} - - "disk-averaged U,V,W (undisturbed)" m/s +typedef ^ RotMiscVarType ReKi AvgDiskVelDist {3} - - "disk-averaged U,V,W (disturbed)" m/s +# TailFin +typedef ^ RotMiscVarType ReKi TFinAlpha - - - "Angle of attack for tailfin" +typedef ^ RotMiscVarType ReKi TFinRe - - - "Reynolds number for tailfin" +typedef ^ RotMiscVarType ReKi TFinVrel - - - "Orthogonal relative velocity nrom at the reference point" +typedef ^ RotMiscVarType ReKi TFinVund_i 3 - - "Undisturbed wind velocity at the reference point of the fin in the inertial system" +typedef ^ RotMiscVarType ReKi TFinVind_i 3 - - "Induced velocity at the reference point of the fin in the inertial system" +typedef ^ RotMiscVarType ReKi TFinVrel_i 3 - - "Relative velocity at the reference point of the fin in the inertial system" +typedef ^ RotMiscVarType ReKi TFinSTV_i 3 - - "Structural velocity at the reference point of the fin in the inertial system" +typedef ^ RotMiscVarType ReKi TFinF_i 3 - - "Forces at the reference point of the fin in the inertial system" +typedef ^ RotMiscVarType ReKi TFinM_i 3 - - "Moments at the reference point of the fin in the inertial system" + +typedef ^ MiscVarType RotMiscVarType rotors {:} - - "MiscVars for each rotor" - +typedef ^ MiscVarType FVW_InputType FVW_u : - - "Inputs to the FVW module" - +typedef ^ MiscVarType FVW_OutputType FVW_y - - - "Outputs from the FVW module" - +typedef ^ MiscVarType FVW_MiscVarType FVW - - - "MiscVars from the FVW module" - +typedef ^ MiscVarType ReKi WindPos {:}{:} - - "XYZ coordinates to query for wind velocity/acceleration" - +typedef ^ MiscVarType ReKi WindVel {:}{:} - - "XYZ components of wind velocity" - +typedef ^ MiscVarType ReKi WindAcc {:}{:} - - "XYZ components of wind acceleration" - +typedef ^ MiscVarType SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState WaveField module" - +typedef ^ MiscVarType AD_InflowType Inflow {:} - - "Inflow storage (size of u for history of inputs)" - diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 68cc48710c..8a94806184 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -36,31 +36,35 @@ MODULE AeroDyn_Types USE FVW_Types USE AeroAcoustics_Types USE InflowWind_Types +USE SeaSt_WaveField_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: ModelUnknown = -1 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WakeMod_none = 0 ! Wake model - none [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WakeMod_BEMT = 1 ! Wake model - BEMT (blade elememnt momentum theory) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WakeMod_FVW = 3 ! Wake model - FVW (free vortex wake, OLAF) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TwrPotent_none = 0 ! no tower potential flow [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TwrPotent_baseline = 1 ! baseline tower potential flow [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TwrPotent_Bak = 2 ! tower potential flow with Bak correction [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TwrShadow_none = 0 ! no tower shadow [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TwrShadow_Powles = 1 ! Powles tower shadow model [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TwrShadow_Eames = 2 ! Eames tower shadow model [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TwrAero_none = 0 ! no tower aero [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TwrAero_noVIV = 1 ! Tower aero model without VIV [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TwrAero_VIV = 2 ! Tower aero model with VIV [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SA_Wgt_Uniform = 1 ! Sector average weighting - Uniform [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TFinAero_none = 0 ! no tail fin aero [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TFinAero_polar = 1 ! polar-based tail fin aerodynamics [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TFinAero_USB = 2 ! unsteady slender body tail fin aerodynamics model [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TFinIndMod_none = 0 ! no induction [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TFinIndMod_rotavg = 1 ! rotor averaged induction [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: APM_BEM_NoSweepPitchTwist = 1 ! Original AeroDyn model where momentum balance is done in the WithoutSweepPitchTwist system [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: APM_BEM_Polar = 2 ! Use staggered polar grid for momentum balance in each annulus [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: APM_LiftingLine = 3 ! Use the blade lifting line (i.e. the structural) orientation (currently for OLAF with VAWT) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AD_MaxBl_Out = 3 ! Maximum number of blades for information output (or linearization) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ModelUnknown = -1 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WakeMod_none = 0 ! Wake model - none [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WakeMod_BEMT = 1 ! Wake model - BEMT (blade elememnt momentum theory) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WakeMod_FVW = 3 ! Wake model - FVW (free vortex wake, OLAF) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TwrPotent_none = 0 ! no tower potential flow [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TwrPotent_baseline = 1 ! baseline tower potential flow [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TwrPotent_Bak = 2 ! tower potential flow with Bak correction [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TwrShadow_none = 0 ! no tower shadow [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TwrShadow_Powles = 1 ! Powles tower shadow model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TwrShadow_Eames = 2 ! Eames tower shadow model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TwrAero_none = 0 ! no tower aero [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TwrAero_noVIV = 1 ! Tower aero model without VIV [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TwrAero_VIV = 2 ! Tower aero model with VIV [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SA_Wgt_Uniform = 1 ! Sector average weighting - Uniform [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TFinAero_none = 0 ! no tail fin aero [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TFinAero_polar = 1 ! polar-based tail fin aerodynamics [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TFinAero_USB = 2 ! unsteady slender body tail fin aerodynamics model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TFinIndMod_none = 0 ! no induction [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TFinIndMod_rotavg = 1 ! rotor averaged induction [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: APM_BEM_NoSweepPitchTwist = 1 ! Original AeroDyn model where momentum balance is done in the WithoutSweepPitchTwist system [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: APM_BEM_Polar = 2 ! Use staggered polar grid for momentum balance in each annulus [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: APM_LiftingLine = 3 ! Use the blade lifting line (i.e. the structural) orientation (currently for OLAF with VAWT) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AD_MaxBl_Out = 3 ! Maximum number of blades for information output (or linearization) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AD_u_HWindSpeed = -1 ! DatLoc number for HWindSpeed extended input [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AD_u_PLExp = -2 ! DatLoc number for PLExp extended input [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AD_u_PropagationDir = -3 ! DatLoc number for PropagationDir extended input [-] ! ========= TFinParameterType ======= TYPE, PUBLIC :: TFinParameterType INTEGER(IntKi) :: TFinMod = 0_IntKi !< Tail fin aerodynamics model {0=none, 1=polar-based, 2=USB-based} [(switch)] @@ -127,6 +131,7 @@ MODULE AeroDyn_Types LOGICAL :: CompAeroMaps = .FALSE. !< flag to determine if AeroDyn is computing aero maps (true) or running a normal simulation (false) [-] REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity force [Nm/s^2] INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type switch [-] + LOGICAL :: CompSeaSt = .false. !< Flag to indicate whether SeaState is selected [-] REAL(ReKi) :: defFldDens = 0.0_ReKi !< Default fluid density from the driver; may be overwritten [kg/m^3] REAL(ReKi) :: defKinVisc = 0.0_ReKi !< Default kinematic viscosity from the driver; may be overwritten [m^2/s] REAL(ReKi) :: defSpdSound = 0.0_ReKi !< Default speed of sound from the driver; may be overwritten [m/s] @@ -147,9 +152,15 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlTwist !< Twist at blade node [radians] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlChord !< Chord at blade node [m] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BlAFID !< ID of Airfoil at blade node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: t_c !< Thickness to chord ratio at blade node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCb !< Coefficient of buoyancy at blade node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCenBn !< Center of buoyancy normal offset at blade node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCenBt !< Center of buoyancy tangential offset at blade node [m] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCpn !< Chordwise coefficient of dynamic pressure at blade node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCpt !< Edgewise coefficient of dynamic pressure at blade node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCan !< Chordwise coefficient of added mass at blade node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCat !< Edgewise coefficient of added mass at blade node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCam !< Pitch coefficient of added mass at blade node [-] END TYPE AD_BladePropsType ! ======================= ! ========= AD_BladeShape ======= @@ -159,6 +170,7 @@ MODULE AeroDyn_Types ! ======================= ! ========= RotInitOutputType ======= TYPE, PUBLIC :: RotInitOutputType + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] @@ -192,6 +204,8 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCd !< Coefficient of drag at tower node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrTI !< Turbulence intensity for tower shadow at tower node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCb !< Coefficient of buoyancy at tower node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCp !< Coefficient of dynamic pressure at tower node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCa !< Coefficient of added mass at tower node [-] REAL(ReKi) :: VolHub = 0.0_ReKi !< Hub volume [m^3] REAL(ReKi) :: HubCenBx = 0.0_ReKi !< Hub center of buoyancy x direction offset [m] REAL(ReKi) :: VolNac = 0.0_ReKi !< Nacelle volume [m^3] @@ -214,7 +228,6 @@ MODULE AeroDyn_Types INTEGER(IntKi) :: TwrShadow = 0_IntKi !< Type of tower influence on wind based on downstream tower shadow {0=none, 1=Powles model, 2=Eames model} [-] INTEGER(IntKi) :: TwrAero = 0_IntKi !< Calculate tower aerodynamic loads? {0=none, 1=aero without VIV, 2=aero with VIV} [-] LOGICAL :: CavitCheck = .false. !< Flag that tells us if we want to check for cavitation [-] - LOGICAL :: Buoyancy = .false. !< Include buoyancy effects? [flag] LOGICAL :: NacelleDrag = .false. !< Include NacelleDrag effects? [flag] LOGICAL :: CompAA = .false. !< Compute AeroAcoustic noise [flag] CHARACTER(1024) :: AA_InputFile !< AeroAcoustics input file name [quoted strings] @@ -319,75 +332,6 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WakeLocationPoints !< wake points velocity [m/s] END TYPE AD_OtherStateType ! ======================= -! ========= RotMiscVarType ======= - TYPE, PUBLIC :: RotMiscVarType - TYPE(BEMT_MiscVarType) :: BEMT !< MiscVars from the BEMT module [-] - TYPE(BEMT_OutputType) :: BEMT_y !< Outputs from the BEMT module [-] - TYPE(BEMT_InputType) , DIMENSION(1:2) :: BEMT_u !< Inputs to the BEMT module [-] - TYPE(AA_MiscVarType) :: AA !< MiscVars from the AA module [-] - TYPE(AA_OutputType) :: AA_y !< Outputs from the AA module [-] - TYPE(AA_InputType) :: AA_u !< Inputs to the AA module [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: DisturbedInflow !< InflowOnBlade values modified by tower influence [m/s] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: SectAvgInflow !< Sector averaged - disturbed inflow to improve BEM shear calculations [m/s] - REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: orientationAnnulus !< Coordinate system equivalent to BladeMotion Orientation, but without live sweep, blade-pitch, and twist angles [-] - REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: R_li !< Transformation matrix from inertial system to the staggered polar coordinate system of a given section [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: W_Twr !< relative wind speed normal to the tower at node j [m/s] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: X_Twr !< local x-component of force per unit length of the jth node in the tower [m/s] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Y_Twr !< local y-component of force per unit length of the jth node in the tower [m/s] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Cant !< curvature angle, saved for possible output to file [rad] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Toe !< Toe angle, saved for possible output to file [rad] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrClrnc !< Distance between tower (including tower radius) and blade node (not including blade width), saved for possible output to file [m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: X !< normal force per unit length (normal to the plane, not chord) of the jth node in the kth blade [N/m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Y !< tangential force per unit length (tangential to the plane, not chord) of the jth node in the kth blade [N/m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Z !< axial force per unit length (tangential to the plane, not chord) of the jth node in the kth blade [N/m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: M !< pitching moment per unit length of the jth node in the kth blade [Nm/m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Mx !< pitching moment per unit length of the jth node in the kth blade (in x direction) [Nm/m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: My !< pitching moment per unit length of the jth node in the kth blade (in y direction) [Nm/m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Mz !< pitching moment per unit length of the jth node in the kth blade (in z direction) [Nm/m] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Vind_i !< Induced velocities at jth node and kth blade (3xnSpanxnB) [m/s] - REAL(ReKi) , DIMENSION(1:3) :: V_DiskAvg = 0.0_ReKi !< disk-average relative wind speed [m/s] - REAL(ReKi) :: yaw = 0.0_ReKi !< Yaw calculated in SetInputsForBEMT [rad] - REAL(ReKi) :: tilt = 0.0_ReKi !< tilt calculated in SetInputsForBEMT [rad] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: hub_theta_x_root !< angles saved for FAST.Farm [rad] - REAL(ReKi) :: V_dot_x = 0.0_ReKi - TYPE(MeshType) :: HubLoad !< mesh at hub; used to compute an integral for mapping the output blade loads to a single point (for writing to file only) [-] - TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: B_L_2_H_P !< mapping data structure to map each bladeLoad output mesh to the MiscVar%HubLoad mesh [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SigmaCavitCrit !< critical cavitation number- inception value (above which cavit will occur) [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SigmaCavit !< cavitation number at node [-] - LOGICAL , DIMENSION(:,:), ALLOCATABLE :: CavitWarnSet !< cavitation warning issued [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrFB !< buoyant force per unit length at tower node [N/m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrMB !< buoyant moment per unit length at tower node [Nm/m] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HubFB !< buoyant force at hub node [N] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HubMB !< buoyant moment at hub node [Nm] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacFB !< buoyant force at nacelle (tower top) node [N] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacMB !< buoyant moment at nacelle (tower top) node [Nm] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacDragF !< drag force at nacelle (tower top) node [N] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacDragM !< drag moment at nacelle (tower top) node [Nm] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacFi !< Total force at nacelle (tower top) node [N] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacMi !< Total moment at nacelle (tower top) node [Nm] - TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeRootLoad !< meshes at blade root; used to compute an integral for mapping the output blade loads to single points (for writing to file only) [-] - TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: B_L_2_R_P !< mapping data structure to map each bladeLoad output mesh to corresponding MiscVar%BladeRootLoad mesh [-] - TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeBuoyLoadPoint !< point mesh for lumped buoyant blade loads [-] - TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeBuoyLoad !< line mesh for per unit length buoyant blade loads [-] - TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: B_P_2_B_L !< mapping data structure to map buoyant blade point loads (m%BladeBuoyLoadPoint) to buoyant blade line loads (m%BladeBuoyLoad) [-] - TYPE(MeshType) :: TwrBuoyLoadPoint !< point mesh for lumped buoyant tower loads [-] - TYPE(MeshType) :: TwrBuoyLoad !< line mesh for per unit length buoyant tower loads [-] - TYPE(MeshMapType) :: T_P_2_T_L !< mapping data structure to map buoyant tower point loads (m%TwrBuoyLoadPoint) to buoyant tower line loads (m%TwrBuoyLoad) [-] - LOGICAL :: FirstWarn_TowerStrike = .false. !< flag to avoid printing tower strike multiple times [-] - REAL(ReKi) , DIMENSION(1:3) :: AvgDiskVel = 0.0_ReKi !< disk-averaged U,V,W (undisturbed) [m/s] - REAL(ReKi) , DIMENSION(1:3) :: AvgDiskVelDist = 0.0_ReKi !< disk-averaged U,V,W (disturbed) [m/s] - REAL(ReKi) :: TFinAlpha = 0.0_ReKi !< Angle of attack for tailfin [-] - REAL(ReKi) :: TFinRe = 0.0_ReKi !< Reynolds number for tailfin [-] - REAL(ReKi) :: TFinVrel = 0.0_ReKi !< Orthogonal relative velocity nrom at the reference point [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinVund_i = 0.0_ReKi !< Undisturbed wind velocity at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinVind_i = 0.0_ReKi !< Induced velocity at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinVrel_i = 0.0_ReKi !< Relative velocity at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinSTV_i = 0.0_ReKi !< Structural velocity at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinF_i = 0.0_ReKi !< Forces at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinM_i = 0.0_ReKi !< Moments at the reference point of the fin in the inertial system [-] - END TYPE RotMiscVarType -! ======================= ! ========= ElemInflowType ======= TYPE, PUBLIC :: ElemInflowType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: InflowVel !< U,V,W at nodes on element (note if we change the requirement that NumNodes is the same for each blade, this will need to change) [m/s] @@ -410,41 +354,9 @@ MODULE AeroDyn_Types TYPE(RotInflowType) , DIMENSION(:), ALLOCATABLE :: RotInflow !< Inflow on rotor [-] END TYPE AD_InflowType ! ======================= -! ========= AD_MiscVarType ======= - TYPE, PUBLIC :: AD_MiscVarType - TYPE(RotMiscVarType) , DIMENSION(:), ALLOCATABLE :: rotors !< MiscVars for each rotor [-] - TYPE(FVW_InputType) , DIMENSION(:), ALLOCATABLE :: FVW_u !< Inputs to the FVW module [-] - TYPE(FVW_OutputType) :: FVW_y !< Outputs from the FVW module [-] - TYPE(FVW_MiscVarType) :: FVW !< MiscVars from the FVW module [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindPos !< XYZ coordinates to query for wind velocity/acceleration [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindVel !< XYZ components of wind velocity [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindAcc !< XYZ components of wind acceleration [-] - TYPE(AD_InflowType) , DIMENSION(:), ALLOCATABLE :: Inflow !< Inflow storage (size of u for history of inputs) [-] - END TYPE AD_MiscVarType -! ======================= -! ========= Jac_u_idxStarts ======= - TYPE, PUBLIC :: Jac_u_idxStarts - INTEGER(IntKi) :: Nacelle = 1 !< Index to first point in u jacobian for Nacelle [-] - INTEGER(IntKi) :: Hub = 1 !< Index to first point in u jacobian for Hub [-] - INTEGER(IntKi) :: TFin = 1 !< Index to first point in u jacobian for TFin [-] - INTEGER(IntKi) :: Tower = 1 !< Index to first point in u jacobian for Tower [-] - INTEGER(IntKi) :: BladeRoot = 1 !< Index to first point in u jacobian for BladeRoot [-] - INTEGER(IntKi) :: Blade = 1 !< Index to first point in u jacobian for Blade [-] - INTEGER(IntKi) :: UserProp = 1 !< Index to first point in u jacobian for UserProp [-] - INTEGER(IntKi) :: Extended = 1 !< Index to first point in u jacobian for Extended [-] - END TYPE Jac_u_idxStarts -! ======================= -! ========= Jac_y_idxStarts ======= - TYPE, PUBLIC :: Jac_y_idxStarts - INTEGER(IntKi) :: NacelleLoad = 1 !< Index to first point in y jacobian for NacelleLoad [-] - INTEGER(IntKi) :: HubLoad = 1 !< Index to first point in y jacobian for HubLoad [-] - INTEGER(IntKi) :: TFinLoad = 1 !< Index to first point in y jacobian for TFinLoad [-] - INTEGER(IntKi) :: TowerLoad = 1 !< Index to first point in y jacobian for TowerLoad [-] - INTEGER(IntKi) :: BladeLoad = 1 !< Index to first point in y jacobian for BladeLoad [-] - END TYPE Jac_y_idxStarts -! ======================= ! ========= RotParameterType ======= TYPE, PUBLIC :: RotParameterType + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] INTEGER(IntKi) :: NumBlNds = 0_IntKi !< Number of nodes on each blade [-] INTEGER(IntKi) :: NumTwrNds = 0_IntKi !< Number of nodes on the tower [-] @@ -453,6 +365,8 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrTI !< Turbulence intensity for tower shadow at tower node [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlTwist !< Twist at blade node [radians] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCb !< Coefficient of buoyancy at tower node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCp !< Coefficient of dynamic pressure at tower node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCa !< Coefficient of added mass at tower node [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlCenBn !< Normal offset between aerodynamic center and center of buoyancy at blade node [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlCenBt !< Tangential offset between aerodynamic center and center of buoyancy at blade node [m] REAL(ReKi) :: VolHub = 0.0_ReKi !< Hub volume [m^3] @@ -468,15 +382,19 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlDL !< Matrix of blade element length based on CB, used in buoyancy calculation [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlTaper !< Matrix of blade element taper, used in buoyancy calculation [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlAxCent !< Matrix of blade element axial centroid, used in buoyancy calculation [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlIN !< Matrix of blade node normal-to-chord inertia factor [kg/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlIT !< Matrix of blade node tangential-to-chord inertia factor [kg/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlAN !< Matrix of blade node normal-to-chord added mass factor [kg/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlAT !< Matrix of blade node tangential-to-chord added mass factor [kg/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlAM !< Matrix of blade node pitch added mass factor [kgm] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrRad !< Array of equivalent tower radius at each node, used in buoyancy calculation [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrDL !< Array of tower element length, used in buoyancy calculation [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrTaper !< Array of tower element taper, used in buoyancy calculation [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrAxCent !< Array of tower element axial centroid, used in buoyancy calculation [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrIT !< Array of tower node tangential inertia factor [kg/m] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrAT !< Array of tower node tangential added mass factor [kg/m] TYPE(BEMT_ParameterType) :: BEMT !< Parameters for BEMT module [-] TYPE(AA_ParameterType) :: AA !< Parameters for AA module [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] - TYPE(Jac_u_idxStarts) :: Jac_u_idxStartList !< Starting indices for all Jac_u components [-] - TYPE(Jac_y_idxStarts) :: Jac_y_idxStartList !< Starting indices for all Jac_y components [-] INTEGER(IntKi) :: NumExtendedInputs = 0_IntKi !< number of extended inputs [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] @@ -487,7 +405,6 @@ MODULE AeroDyn_Types INTEGER(IntKi) :: TwrAero = 0_IntKi !< Calculate tower aerodynamic loads? {0=none, 1=aero without VIV, 2=aero with VIV} [switch] INTEGER(IntKi) :: DBEMT_Mod = 0_IntKi !< DBEMT_Mod [-] LOGICAL :: CavitCheck = .false. !< Flag that tells us if we want to check for cavitation [-] - LOGICAL :: Buoyancy = .false. !< Include buoyancy effects? [flag] LOGICAL :: NacelleDrag = .false. !< Include NacelleDrag effects? [flag] INTEGER(IntKi) :: MHK = 0_IntKi !< MHK [flag] LOGICAL :: CompAA = .false. !< Compute AeroAcoustic noise [flag] @@ -529,12 +446,14 @@ MODULE AeroDyn_Types TYPE(FVW_ParameterType) :: FVW !< Parameters for FVW module [-] LOGICAL :: CompAeroMaps = .FALSE. !< flag to determine if AeroDyn is computing aero maps (true) or running a normal simulation (false) [-] LOGICAL :: UA_Flag = .false. !< logical flag indicating whether to use UnsteadyAero [-] + LOGICAL :: CompSeaSt = .false. !< Flag to indicate whether SeaState is selected [-] TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Pointer of InflowWinds flow field data type [-] LOGICAL :: SectAvg = .false. !< Use Sector average for BEM inflow velocity calculation [-] INTEGER(IntKi) :: SA_Weighting = 0_IntKi !< Sector Average - Weighting function for sector average {1=Uniform, 2=Impulse} within a 360/nB sector centered on the blade (switch) [used only when SectAvg=True] [-] REAL(ReKi) :: SA_PsiBwd = 0.0_ReKi !< Sector Average - Backard Azimuth (<0) [deg] REAL(ReKi) :: SA_PsiFwd = 0.0_ReKi !< Sector Average - Forward Azimuth (>0) [deg] INTEGER(IntKi) :: SA_nPerSec = 0_IntKi !< Sector Average - Number of points per sector (>1) [-] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field data type [-] END TYPE AD_ParameterType ! ======================= ! ========= RotInputType ======= @@ -568,7 +487,124 @@ MODULE AeroDyn_Types TYPE(RotOutputType) , DIMENSION(:), ALLOCATABLE :: rotors !< Ouputs for each rotor [-] END TYPE AD_OutputType ! ======================= -CONTAINS +! ========= RotMiscVarType ======= + TYPE, PUBLIC :: RotMiscVarType + TYPE(ModJacType) :: Jac !< Values corresponding to module variables [-] + TYPE(RotContinuousStateType) :: x_init !< [-] + TYPE(RotContinuousStateType) :: x_perturb !< [-] + TYPE(RotContinuousStateType) :: dxdt_lin !< [-] + TYPE(RotInputType) :: u_perturb !< [-] + TYPE(RotOutputType) :: y_lin !< [-] + TYPE(RotConstraintStateType) :: z_lin !< [-] + TYPE(RotOtherStateType) :: OtherState_init !< [-] + TYPE(RotOtherStateType) :: OtherState_jac !< [-] + TYPE(BEMT_MiscVarType) :: BEMT !< MiscVars from the BEMT module [-] + TYPE(BEMT_OutputType) :: BEMT_y !< Outputs from the BEMT module [-] + TYPE(BEMT_InputType) , DIMENSION(1:2) :: BEMT_u !< Inputs to the BEMT module [-] + TYPE(AA_MiscVarType) :: AA !< MiscVars from the AA module [-] + TYPE(AA_OutputType) :: AA_y !< Outputs from the AA module [-] + TYPE(AA_InputType) :: AA_u !< Inputs to the AA module [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: DisturbedInflow !< InflowOnBlade values modified by tower influence [m/s] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: SectAvgInflow !< Sector averaged - disturbed inflow to improve BEM shear calculations [m/s] + REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: orientationAnnulus !< Coordinate system equivalent to BladeMotion Orientation, but without live sweep, blade-pitch, and twist angles [-] + REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: R_li !< Transformation matrix from inertial system to the staggered polar coordinate system of a given section [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: W_Twr !< relative wind speed normal to the tower at node j [m/s] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: X_Twr !< local x-component of force per unit length of the jth node in the tower [m/s] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Y_Twr !< local y-component of force per unit length of the jth node in the tower [m/s] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Cant !< curvature angle, saved for possible output to file [rad] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Toe !< Toe angle, saved for possible output to file [rad] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrClrnc !< Distance between tower (including tower radius) and blade node (not including blade width), saved for possible output to file [m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: X !< normal force per unit length (normal to the plane, not chord) of the jth node in the kth blade [N/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Y !< tangential force per unit length (tangential to the plane, not chord) of the jth node in the kth blade [N/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Z !< axial force per unit length (tangential to the plane, not chord) of the jth node in the kth blade [N/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: M !< pitching moment per unit length of the jth node in the kth blade [Nm/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Mx !< pitching moment per unit length of the jth node in the kth blade (in x direction) [Nm/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: My !< pitching moment per unit length of the jth node in the kth blade (in y direction) [Nm/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Mz !< pitching moment per unit length of the jth node in the kth blade (in z direction) [Nm/m] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Vind_i !< Induced velocities at jth node and kth blade (3xnSpanxnB) [m/s] + REAL(ReKi) , DIMENSION(1:3) :: V_DiskAvg = 0.0_ReKi !< disk-average relative wind speed [m/s] + REAL(ReKi) :: yaw = 0.0_ReKi !< Yaw calculated in SetInputsForBEMT [rad] + REAL(ReKi) :: tilt = 0.0_ReKi !< tilt calculated in SetInputsForBEMT [rad] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: hub_theta_x_root !< angles saved for FAST.Farm [rad] + REAL(ReKi) :: V_dot_x = 0.0_ReKi + TYPE(MeshType) :: HubLoad !< mesh at hub; used to compute an integral for mapping the output blade loads to a single point (for writing to file only) [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: B_L_2_H_P !< mapping data structure to map each bladeLoad output mesh to the MiscVar%HubLoad mesh [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SigmaCavitCrit !< critical cavitation number- inception value (above which cavit will occur) [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SigmaCavit !< cavitation number at node [-] + LOGICAL , DIMENSION(:,:), ALLOCATABLE :: CavitWarnSet !< cavitation warning issued [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrFB !< buoyant force per unit length at tower node [N/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrMB !< buoyant moment per unit length at tower node [Nm/m] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HubFB !< buoyant force at hub node [N] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HubMB !< buoyant moment at hub node [Nm] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacFB !< buoyant force at nacelle (tower top) node [N] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacMB !< buoyant moment at nacelle (tower top) node [Nm] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacDragF !< drag force at nacelle (tower top) node [N] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacDragM !< drag moment at nacelle (tower top) node [Nm] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacFi !< Total force at nacelle (tower top) node [N] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacMi !< Total moment at nacelle (tower top) node [Nm] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: BlFI !< inertia force per unit length at blade node [N/m] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: BlFA !< added mass force per unit length at blade node [N/m] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: BlMA !< added mass moment per unit length at blade node [N/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrFI !< inertia force per unit length at tower node [N/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrFA !< added mass force per unit length at tower node [N/m] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeRootLoad !< meshes at blade root; used to compute an integral for mapping the output blade loads to single points (for writing to file only) [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: B_L_2_R_P !< mapping data structure to map each bladeLoad output mesh to corresponding MiscVar%BladeRootLoad mesh [-] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeBuoyLoadPoint !< point mesh for lumped buoyant blade loads [-] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeBuoyLoad !< line mesh for per unit length buoyant blade loads [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: B_P_2_B_L !< mapping data structure to map buoyant blade point loads (m%BladeBuoyLoadPoint) to buoyant blade line loads (m%BladeBuoyLoad) [-] + TYPE(MeshType) :: TwrBuoyLoadPoint !< point mesh for lumped buoyant tower loads [-] + TYPE(MeshType) :: TwrBuoyLoad !< line mesh for per unit length buoyant tower loads [-] + TYPE(MeshMapType) :: T_P_2_T_L !< mapping data structure to map buoyant tower point loads (m%TwrBuoyLoadPoint) to buoyant tower line loads (m%TwrBuoyLoad) [-] + LOGICAL :: FirstWarn_TowerStrike = .false. !< flag to avoid printing tower strike multiple times [-] + REAL(ReKi) , DIMENSION(1:3) :: AvgDiskVel = 0.0_ReKi !< disk-averaged U,V,W (undisturbed) [m/s] + REAL(ReKi) , DIMENSION(1:3) :: AvgDiskVelDist = 0.0_ReKi !< disk-averaged U,V,W (disturbed) [m/s] + REAL(ReKi) :: TFinAlpha = 0.0_ReKi !< Angle of attack for tailfin [-] + REAL(ReKi) :: TFinRe = 0.0_ReKi !< Reynolds number for tailfin [-] + REAL(ReKi) :: TFinVrel = 0.0_ReKi !< Orthogonal relative velocity nrom at the reference point [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinVund_i = 0.0_ReKi !< Undisturbed wind velocity at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinVind_i = 0.0_ReKi !< Induced velocity at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinVrel_i = 0.0_ReKi !< Relative velocity at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinSTV_i = 0.0_ReKi !< Structural velocity at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinF_i = 0.0_ReKi !< Forces at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinM_i = 0.0_ReKi !< Moments at the reference point of the fin in the inertial system [-] + END TYPE RotMiscVarType +! ======================= +! ========= AD_MiscVarType ======= + TYPE, PUBLIC :: AD_MiscVarType + TYPE(RotMiscVarType) , DIMENSION(:), ALLOCATABLE :: rotors !< MiscVars for each rotor [-] + TYPE(FVW_InputType) , DIMENSION(:), ALLOCATABLE :: FVW_u !< Inputs to the FVW module [-] + TYPE(FVW_OutputType) :: FVW_y !< Outputs from the FVW module [-] + TYPE(FVW_MiscVarType) :: FVW !< MiscVars from the FVW module [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindPos !< XYZ coordinates to query for wind velocity/acceleration [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindVel !< XYZ components of wind velocity [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindAcc !< XYZ components of wind acceleration [-] + TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState WaveField module [-] + TYPE(AD_InflowType) , DIMENSION(:), ALLOCATABLE :: Inflow !< Inflow storage (size of u for history of inputs) [-] + END TYPE AD_MiscVarType +! ======================= + integer(IntKi), public, parameter :: AD_x_BEMT_UA_element_x = 1 ! AD%BEMT%UA%element(DL%i1, DL%i2)%x + integer(IntKi), public, parameter :: AD_x_BEMT_DBEMT_element_vind = 2 ! AD%BEMT%DBEMT%element(DL%i1, DL%i2)%vind + integer(IntKi), public, parameter :: AD_x_BEMT_DBEMT_element_vind_1 = 3 ! AD%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1 + integer(IntKi), public, parameter :: AD_x_BEMT_V_w = 4 ! AD%BEMT%V_w + integer(IntKi), public, parameter :: AD_x_AA_DummyContState = 5 ! AD%AA%DummyContState + integer(IntKi), public, parameter :: AD_z_BEMT_phi = 6 ! AD%BEMT%phi + integer(IntKi), public, parameter :: AD_z_AA_DummyConstrState = 7 ! AD%AA%DummyConstrState + integer(IntKi), public, parameter :: AD_u_NacelleMotion = 8 ! AD%NacelleMotion + integer(IntKi), public, parameter :: AD_u_TowerMotion = 9 ! AD%TowerMotion + integer(IntKi), public, parameter :: AD_u_HubMotion = 10 ! AD%HubMotion + integer(IntKi), public, parameter :: AD_u_BladeRootMotion = 11 ! AD%BladeRootMotion(DL%i1) + integer(IntKi), public, parameter :: AD_u_BladeMotion = 12 ! AD%BladeMotion(DL%i1) + integer(IntKi), public, parameter :: AD_u_TFinMotion = 13 ! AD%TFinMotion + integer(IntKi), public, parameter :: AD_u_UserProp = 14 ! AD%UserProp + integer(IntKi), public, parameter :: AD_y_NacelleLoad = 15 ! AD%NacelleLoad + integer(IntKi), public, parameter :: AD_y_HubLoad = 16 ! AD%HubLoad + integer(IntKi), public, parameter :: AD_y_TowerLoad = 17 ! AD%TowerLoad + integer(IntKi), public, parameter :: AD_y_BladeLoad = 18 ! AD%BladeLoad(DL%i1) + integer(IntKi), public, parameter :: AD_y_TFinLoad = 19 ! AD%TFinLoad + integer(IntKi), public, parameter :: AD_y_WriteOutput = 20 ! AD%WriteOutput + +contains subroutine AD_CopyTFinParameterType(SrcTFinParameterTypeData, DstTFinParameterTypeData, CtrlCode, ErrStat, ErrMsg) type(TFinParameterType), intent(in) :: SrcTFinParameterTypeData @@ -1013,6 +1049,7 @@ subroutine AD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%CompAeroMaps = SrcInitInputData%CompAeroMaps DstInitInputData%Gravity = SrcInitInputData%Gravity DstInitInputData%MHK = SrcInitInputData%MHK + DstInitInputData%CompSeaSt = SrcInitInputData%CompSeaSt DstInitInputData%defFldDens = SrcInitInputData%defFldDens DstInitInputData%defKinVisc = SrcInitInputData%defKinVisc DstInitInputData%defSpdSound = SrcInitInputData%defSpdSound @@ -1073,6 +1110,7 @@ subroutine AD_PackInitInput(RF, Indata) call RegPack(RF, InData%CompAeroMaps) call RegPack(RF, InData%Gravity) call RegPack(RF, InData%MHK) + call RegPack(RF, InData%CompSeaSt) call RegPack(RF, InData%defFldDens) call RegPack(RF, InData%defKinVisc) call RegPack(RF, InData%defSpdSound) @@ -1122,6 +1160,7 @@ subroutine AD_UnPackInitInput(RF, OutData) call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompSeaSt); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%defFldDens); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%defKinVisc); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%defSpdSound); if (RegCheckErr(RF, RoutineName)) return @@ -1245,6 +1284,18 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C end if DstBladePropsTypeData%BlAFID = SrcBladePropsTypeData%BlAFID end if + if (allocated(SrcBladePropsTypeData%t_c)) then + LB(1:1) = lbound(SrcBladePropsTypeData%t_c) + UB(1:1) = ubound(SrcBladePropsTypeData%t_c) + if (.not. allocated(DstBladePropsTypeData%t_c)) then + allocate(DstBladePropsTypeData%t_c(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%t_c.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%t_c = SrcBladePropsTypeData%t_c + end if if (allocated(SrcBladePropsTypeData%BlCb)) then LB(1:1) = lbound(SrcBladePropsTypeData%BlCb) UB(1:1) = ubound(SrcBladePropsTypeData%BlCb) @@ -1281,6 +1332,66 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C end if DstBladePropsTypeData%BlCenBt = SrcBladePropsTypeData%BlCenBt end if + if (allocated(SrcBladePropsTypeData%BlCpn)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlCpn) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCpn) + if (.not. allocated(DstBladePropsTypeData%BlCpn)) then + allocate(DstBladePropsTypeData%BlCpn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCpn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlCpn = SrcBladePropsTypeData%BlCpn + end if + if (allocated(SrcBladePropsTypeData%BlCpt)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlCpt) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCpt) + if (.not. allocated(DstBladePropsTypeData%BlCpt)) then + allocate(DstBladePropsTypeData%BlCpt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCpt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlCpt = SrcBladePropsTypeData%BlCpt + end if + if (allocated(SrcBladePropsTypeData%BlCan)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlCan) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCan) + if (.not. allocated(DstBladePropsTypeData%BlCan)) then + allocate(DstBladePropsTypeData%BlCan(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCan.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlCan = SrcBladePropsTypeData%BlCan + end if + if (allocated(SrcBladePropsTypeData%BlCat)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlCat) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCat) + if (.not. allocated(DstBladePropsTypeData%BlCat)) then + allocate(DstBladePropsTypeData%BlCat(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlCat = SrcBladePropsTypeData%BlCat + end if + if (allocated(SrcBladePropsTypeData%BlCam)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlCam) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCam) + if (.not. allocated(DstBladePropsTypeData%BlCam)) then + allocate(DstBladePropsTypeData%BlCam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlCam = SrcBladePropsTypeData%BlCam + end if end subroutine subroutine AD_DestroyBladePropsType(BladePropsTypeData, ErrStat, ErrMsg) @@ -1311,6 +1422,9 @@ subroutine AD_DestroyBladePropsType(BladePropsTypeData, ErrStat, ErrMsg) if (allocated(BladePropsTypeData%BlAFID)) then deallocate(BladePropsTypeData%BlAFID) end if + if (allocated(BladePropsTypeData%t_c)) then + deallocate(BladePropsTypeData%t_c) + end if if (allocated(BladePropsTypeData%BlCb)) then deallocate(BladePropsTypeData%BlCb) end if @@ -1320,6 +1434,21 @@ subroutine AD_DestroyBladePropsType(BladePropsTypeData, ErrStat, ErrMsg) if (allocated(BladePropsTypeData%BlCenBt)) then deallocate(BladePropsTypeData%BlCenBt) end if + if (allocated(BladePropsTypeData%BlCpn)) then + deallocate(BladePropsTypeData%BlCpn) + end if + if (allocated(BladePropsTypeData%BlCpt)) then + deallocate(BladePropsTypeData%BlCpt) + end if + if (allocated(BladePropsTypeData%BlCan)) then + deallocate(BladePropsTypeData%BlCan) + end if + if (allocated(BladePropsTypeData%BlCat)) then + deallocate(BladePropsTypeData%BlCat) + end if + if (allocated(BladePropsTypeData%BlCam)) then + deallocate(BladePropsTypeData%BlCam) + end if end subroutine subroutine AD_PackBladePropsType(RF, Indata) @@ -1335,9 +1464,15 @@ subroutine AD_PackBladePropsType(RF, Indata) call RegPackAlloc(RF, InData%BlTwist) call RegPackAlloc(RF, InData%BlChord) call RegPackAlloc(RF, InData%BlAFID) + call RegPackAlloc(RF, InData%t_c) call RegPackAlloc(RF, InData%BlCb) call RegPackAlloc(RF, InData%BlCenBn) call RegPackAlloc(RF, InData%BlCenBt) + call RegPackAlloc(RF, InData%BlCpn) + call RegPackAlloc(RF, InData%BlCpt) + call RegPackAlloc(RF, InData%BlCan) + call RegPackAlloc(RF, InData%BlCat) + call RegPackAlloc(RF, InData%BlCam) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1357,9 +1492,15 @@ subroutine AD_UnPackBladePropsType(RF, OutData) call RegUnpackAlloc(RF, OutData%BlTwist); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%BlChord); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%BlAFID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%t_c); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%BlCb); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%BlCenBn); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%BlCenBt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlCpn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlCpt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlCan); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlCat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlCam); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_CopyBladeShape(SrcBladeShapeData, DstBladeShapeData, CtrlCode, ErrStat, ErrMsg) @@ -1432,6 +1573,7 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy character(*), parameter :: RoutineName = 'AD_CopyRotInitOutputType' ErrStat = ErrID_None ErrMsg = '' + DstRotInitOutputTypeData%Vars => SrcRotInitOutputTypeData%Vars DstRotInitOutputTypeData%AirDens = SrcRotInitOutputTypeData%AirDens if (allocated(SrcRotInitOutputTypeData%WriteOutputHdr)) then LB(1:1) = lbound(SrcRotInitOutputTypeData%WriteOutputHdr) @@ -1622,6 +1764,7 @@ subroutine AD_DestroyRotInitOutputType(RotInitOutputTypeData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AD_DestroyRotInitOutputType' ErrStat = ErrID_None ErrMsg = '' + nullify(RotInitOutputTypeData%Vars) if (allocated(RotInitOutputTypeData%WriteOutputHdr)) then deallocate(RotInitOutputTypeData%WriteOutputHdr) end if @@ -1684,7 +1827,15 @@ subroutine AD_PackRotInitOutputType(RF, Indata) character(*), parameter :: RoutineName = 'AD_PackRotInitOutputType' integer(B4Ki) :: i1 integer(B4Ki) :: LB(1), UB(1) + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if call RegPack(RF, InData%AirDens) call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) @@ -1727,7 +1878,27 @@ subroutine AD_UnPackRotInitOutputType(RF, OutData) integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return @@ -1965,6 +2136,30 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod end if DstRotInputFileData%TwrCb = SrcRotInputFileData%TwrCb end if + if (allocated(SrcRotInputFileData%TwrCp)) then + LB(1:1) = lbound(SrcRotInputFileData%TwrCp) + UB(1:1) = ubound(SrcRotInputFileData%TwrCp) + if (.not. allocated(DstRotInputFileData%TwrCp)) then + allocate(DstRotInputFileData%TwrCp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrCp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputFileData%TwrCp = SrcRotInputFileData%TwrCp + end if + if (allocated(SrcRotInputFileData%TwrCa)) then + LB(1:1) = lbound(SrcRotInputFileData%TwrCa) + UB(1:1) = ubound(SrcRotInputFileData%TwrCa) + if (.not. allocated(DstRotInputFileData%TwrCa)) then + allocate(DstRotInputFileData%TwrCa(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrCa.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputFileData%TwrCa = SrcRotInputFileData%TwrCa + end if DstRotInputFileData%VolHub = SrcRotInputFileData%VolHub DstRotInputFileData%HubCenBx = SrcRotInputFileData%HubCenBx DstRotInputFileData%VolNac = SrcRotInputFileData%VolNac @@ -2014,6 +2209,12 @@ subroutine AD_DestroyRotInputFile(RotInputFileData, ErrStat, ErrMsg) if (allocated(RotInputFileData%TwrCb)) then deallocate(RotInputFileData%TwrCb) end if + if (allocated(RotInputFileData%TwrCp)) then + deallocate(RotInputFileData%TwrCp) + end if + if (allocated(RotInputFileData%TwrCa)) then + deallocate(RotInputFileData%TwrCa) + end if call AD_DestroyTFinInputFileType(RotInputFileData%TFin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -2040,6 +2241,8 @@ subroutine AD_PackRotInputFile(RF, Indata) call RegPackAlloc(RF, InData%TwrCd) call RegPackAlloc(RF, InData%TwrTI) call RegPackAlloc(RF, InData%TwrCb) + call RegPackAlloc(RF, InData%TwrCp) + call RegPackAlloc(RF, InData%TwrCa) call RegPack(RF, InData%VolHub) call RegPack(RF, InData%HubCenBx) call RegPack(RF, InData%VolNac) @@ -2081,6 +2284,8 @@ subroutine AD_UnPackRotInputFile(RF, OutData) call RegUnpackAlloc(RF, OutData%TwrCd); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%TwrTI); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%TwrCb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrCp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrCa); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%VolHub); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%HubCenBx); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%VolNac); if (RegCheckErr(RF, RoutineName)) return @@ -2114,7 +2319,6 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TwrShadow = SrcInputFileData%TwrShadow DstInputFileData%TwrAero = SrcInputFileData%TwrAero DstInputFileData%CavitCheck = SrcInputFileData%CavitCheck - DstInputFileData%Buoyancy = SrcInputFileData%Buoyancy DstInputFileData%NacelleDrag = SrcInputFileData%NacelleDrag DstInputFileData%CompAA = SrcInputFileData%CompAA DstInputFileData%AA_InputFile = SrcInputFileData%AA_InputFile @@ -2282,7 +2486,6 @@ subroutine AD_PackInputFile(RF, Indata) call RegPack(RF, InData%TwrShadow) call RegPack(RF, InData%TwrAero) call RegPack(RF, InData%CavitCheck) - call RegPack(RF, InData%Buoyancy) call RegPack(RF, InData%NacelleDrag) call RegPack(RF, InData%CompAA) call RegPack(RF, InData%AA_InputFile) @@ -2364,7 +2567,6 @@ subroutine AD_UnPackInputFile(RF, OutData) call RegUnpack(RF, OutData%TwrShadow); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%TwrAero); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%CavitCheck); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Buoyancy); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NacelleDrag); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%CompAA); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%AA_InputFile); if (RegCheckErr(RF, RoutineName)) return @@ -3073,1224 +3275,1355 @@ subroutine AD_UnPackOtherState(RF, OutData) call RegUnpackAlloc(RF, OutData%WakeLocationPoints); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, CtrlCode, ErrStat, ErrMsg) - type(RotMiscVarType), intent(inout) :: SrcRotMiscVarTypeData - type(RotMiscVarType), intent(inout) :: DstRotMiscVarTypeData +subroutine AD_CopyElemInflowType(SrcElemInflowTypeData, DstElemInflowTypeData, CtrlCode, ErrStat, ErrMsg) + type(ElemInflowType), intent(in) :: SrcElemInflowTypeData + type(ElemInflowType), intent(inout) :: DstElemInflowTypeData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2, i3, i4 - integer(B4Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyRotMiscVarType' + character(*), parameter :: RoutineName = 'AD_CopyElemInflowType' ErrStat = ErrID_None ErrMsg = '' - call BEMT_CopyMisc(SrcRotMiscVarTypeData%BEMT, DstRotMiscVarTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call BEMT_CopyOutput(SrcRotMiscVarTypeData%BEMT_y, DstRotMiscVarTypeData%BEMT_y, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - LB(1:1) = lbound(SrcRotMiscVarTypeData%BEMT_u) - UB(1:1) = ubound(SrcRotMiscVarTypeData%BEMT_u) - do i1 = LB(1), UB(1) - call BEMT_CopyInput(SrcRotMiscVarTypeData%BEMT_u(i1), DstRotMiscVarTypeData%BEMT_u(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - call AA_CopyMisc(SrcRotMiscVarTypeData%AA, DstRotMiscVarTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call AA_CopyOutput(SrcRotMiscVarTypeData%AA_y, DstRotMiscVarTypeData%AA_y, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call AA_CopyInput(SrcRotMiscVarTypeData%AA_u, DstRotMiscVarTypeData%AA_u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcRotMiscVarTypeData%DisturbedInflow)) then - LB(1:3) = lbound(SrcRotMiscVarTypeData%DisturbedInflow) - UB(1:3) = ubound(SrcRotMiscVarTypeData%DisturbedInflow) - if (.not. allocated(DstRotMiscVarTypeData%DisturbedInflow)) then - allocate(DstRotMiscVarTypeData%DisturbedInflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (allocated(SrcElemInflowTypeData%InflowVel)) then + LB(1:2) = lbound(SrcElemInflowTypeData%InflowVel) + UB(1:2) = ubound(SrcElemInflowTypeData%InflowVel) + if (.not. allocated(DstElemInflowTypeData%InflowVel)) then + allocate(DstElemInflowTypeData%InflowVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%DisturbedInflow.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstElemInflowTypeData%InflowVel.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%DisturbedInflow = SrcRotMiscVarTypeData%DisturbedInflow + DstElemInflowTypeData%InflowVel = SrcElemInflowTypeData%InflowVel end if - if (allocated(SrcRotMiscVarTypeData%SectAvgInflow)) then - LB(1:3) = lbound(SrcRotMiscVarTypeData%SectAvgInflow) - UB(1:3) = ubound(SrcRotMiscVarTypeData%SectAvgInflow) - if (.not. allocated(DstRotMiscVarTypeData%SectAvgInflow)) then - allocate(DstRotMiscVarTypeData%SectAvgInflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (allocated(SrcElemInflowTypeData%InflowAcc)) then + LB(1:2) = lbound(SrcElemInflowTypeData%InflowAcc) + UB(1:2) = ubound(SrcElemInflowTypeData%InflowAcc) + if (.not. allocated(DstElemInflowTypeData%InflowAcc)) then + allocate(DstElemInflowTypeData%InflowAcc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%SectAvgInflow.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstElemInflowTypeData%InflowAcc.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%SectAvgInflow = SrcRotMiscVarTypeData%SectAvgInflow + DstElemInflowTypeData%InflowAcc = SrcElemInflowTypeData%InflowAcc end if - if (allocated(SrcRotMiscVarTypeData%orientationAnnulus)) then - LB(1:4) = lbound(SrcRotMiscVarTypeData%orientationAnnulus) - UB(1:4) = ubound(SrcRotMiscVarTypeData%orientationAnnulus) - if (.not. allocated(DstRotMiscVarTypeData%orientationAnnulus)) then - allocate(DstRotMiscVarTypeData%orientationAnnulus(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%orientationAnnulus.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotMiscVarTypeData%orientationAnnulus = SrcRotMiscVarTypeData%orientationAnnulus +end subroutine + +subroutine AD_DestroyElemInflowType(ElemInflowTypeData, ErrStat, ErrMsg) + type(ElemInflowType), intent(inout) :: ElemInflowTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyElemInflowType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ElemInflowTypeData%InflowVel)) then + deallocate(ElemInflowTypeData%InflowVel) end if - if (allocated(SrcRotMiscVarTypeData%R_li)) then - LB(1:4) = lbound(SrcRotMiscVarTypeData%R_li) - UB(1:4) = ubound(SrcRotMiscVarTypeData%R_li) - if (.not. allocated(DstRotMiscVarTypeData%R_li)) then - allocate(DstRotMiscVarTypeData%R_li(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (allocated(ElemInflowTypeData%InflowAcc)) then + deallocate(ElemInflowTypeData%InflowAcc) + end if +end subroutine + +subroutine AD_PackElemInflowType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ElemInflowType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackElemInflowType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%InflowVel) + call RegPackAlloc(RF, InData%InflowAcc) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackElemInflowType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ElemInflowType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackElemInflowType' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%InflowVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InflowAcc); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyRotInflowType(SrcRotInflowTypeData, DstRotInflowTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotInflowType), intent(in) :: SrcRotInflowTypeData + type(RotInflowType), intent(inout) :: DstRotInflowTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotInflowType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcRotInflowTypeData%Blade)) then + LB(1:1) = lbound(SrcRotInflowTypeData%Blade) + UB(1:1) = ubound(SrcRotInflowTypeData%Blade) + if (.not. allocated(DstRotInflowTypeData%Blade)) then + allocate(DstRotInflowTypeData%Blade(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%R_li.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInflowTypeData%Blade.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%R_li = SrcRotMiscVarTypeData%R_li + do i1 = LB(1), UB(1) + call AD_CopyElemInflowType(SrcRotInflowTypeData%Blade(i1), DstRotInflowTypeData%Blade(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcRotMiscVarTypeData%AllOuts)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%AllOuts) - UB(1:1) = ubound(SrcRotMiscVarTypeData%AllOuts) - if (.not. allocated(DstRotMiscVarTypeData%AllOuts)) then - allocate(DstRotMiscVarTypeData%AllOuts(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%AllOuts.', ErrStat, ErrMsg, RoutineName) - return - end if + call AD_CopyElemInflowType(SrcRotInflowTypeData%Tower, DstRotInflowTypeData%Tower, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstRotInflowTypeData%InflowOnHub = SrcRotInflowTypeData%InflowOnHub + DstRotInflowTypeData%InflowOnNacelle = SrcRotInflowTypeData%InflowOnNacelle + DstRotInflowTypeData%InflowOnTailFin = SrcRotInflowTypeData%InflowOnTailFin + DstRotInflowTypeData%AvgDiskVel = SrcRotInflowTypeData%AvgDiskVel +end subroutine + +subroutine AD_DestroyRotInflowType(RotInflowTypeData, ErrStat, ErrMsg) + type(RotInflowType), intent(inout) :: RotInflowTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotInflowType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RotInflowTypeData%Blade)) then + LB(1:1) = lbound(RotInflowTypeData%Blade) + UB(1:1) = ubound(RotInflowTypeData%Blade) + do i1 = LB(1), UB(1) + call AD_DestroyElemInflowType(RotInflowTypeData%Blade(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotInflowTypeData%Blade) + end if + call AD_DestroyElemInflowType(RotInflowTypeData%Tower, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackRotInflowType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(RotInflowType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotInflowType' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%Blade)) + if (allocated(InData%Blade)) then + call RegPackBounds(RF, 1, lbound(InData%Blade), ubound(InData%Blade)) + LB(1:1) = lbound(InData%Blade) + UB(1:1) = ubound(InData%Blade) + do i1 = LB(1), UB(1) + call AD_PackElemInflowType(RF, InData%Blade(i1)) + end do + end if + call AD_PackElemInflowType(RF, InData%Tower) + call RegPack(RF, InData%InflowOnHub) + call RegPack(RF, InData%InflowOnNacelle) + call RegPack(RF, InData%InflowOnTailFin) + call RegPack(RF, InData%AvgDiskVel) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotInflowType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(RotInflowType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotInflowType' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%Blade)) deallocate(OutData%Blade) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Blade(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Blade.', RF%ErrStat, RF%ErrMsg, RoutineName) + return end if - DstRotMiscVarTypeData%AllOuts = SrcRotMiscVarTypeData%AllOuts + do i1 = LB(1), UB(1) + call AD_UnpackElemInflowType(RF, OutData%Blade(i1)) ! Blade + end do end if - if (allocated(SrcRotMiscVarTypeData%W_Twr)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%W_Twr) - UB(1:1) = ubound(SrcRotMiscVarTypeData%W_Twr) - if (.not. allocated(DstRotMiscVarTypeData%W_Twr)) then - allocate(DstRotMiscVarTypeData%W_Twr(LB(1):UB(1)), stat=ErrStat2) + call AD_UnpackElemInflowType(RF, OutData%Tower) ! Tower + call RegUnpack(RF, OutData%InflowOnHub); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InflowOnNacelle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InflowOnTailFin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgDiskVel); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyInflowType(SrcInflowTypeData, DstInflowTypeData, CtrlCode, ErrStat, ErrMsg) + type(AD_InflowType), intent(in) :: SrcInflowTypeData + type(AD_InflowType), intent(inout) :: DstInflowTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyInflowType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInflowTypeData%InflowWakeVel)) then + LB(1:2) = lbound(SrcInflowTypeData%InflowWakeVel) + UB(1:2) = ubound(SrcInflowTypeData%InflowWakeVel) + if (.not. allocated(DstInflowTypeData%InflowWakeVel)) then + allocate(DstInflowTypeData%InflowWakeVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%W_Twr.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowTypeData%InflowWakeVel.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%W_Twr = SrcRotMiscVarTypeData%W_Twr + DstInflowTypeData%InflowWakeVel = SrcInflowTypeData%InflowWakeVel end if - if (allocated(SrcRotMiscVarTypeData%X_Twr)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%X_Twr) - UB(1:1) = ubound(SrcRotMiscVarTypeData%X_Twr) - if (.not. allocated(DstRotMiscVarTypeData%X_Twr)) then - allocate(DstRotMiscVarTypeData%X_Twr(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInflowTypeData%RotInflow)) then + LB(1:1) = lbound(SrcInflowTypeData%RotInflow) + UB(1:1) = ubound(SrcInflowTypeData%RotInflow) + if (.not. allocated(DstInflowTypeData%RotInflow)) then + allocate(DstInflowTypeData%RotInflow(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%X_Twr.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowTypeData%RotInflow.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%X_Twr = SrcRotMiscVarTypeData%X_Twr + do i1 = LB(1), UB(1) + call AD_CopyRotInflowType(SrcInflowTypeData%RotInflow(i1), DstInflowTypeData%RotInflow(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcRotMiscVarTypeData%Y_Twr)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%Y_Twr) - UB(1:1) = ubound(SrcRotMiscVarTypeData%Y_Twr) - if (.not. allocated(DstRotMiscVarTypeData%Y_Twr)) then - allocate(DstRotMiscVarTypeData%Y_Twr(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Y_Twr.', ErrStat, ErrMsg, RoutineName) - return - end if +end subroutine + +subroutine AD_DestroyInflowType(InflowTypeData, ErrStat, ErrMsg) + type(AD_InflowType), intent(inout) :: InflowTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyInflowType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InflowTypeData%InflowWakeVel)) then + deallocate(InflowTypeData%InflowWakeVel) + end if + if (allocated(InflowTypeData%RotInflow)) then + LB(1:1) = lbound(InflowTypeData%RotInflow) + UB(1:1) = ubound(InflowTypeData%RotInflow) + do i1 = LB(1), UB(1) + call AD_DestroyRotInflowType(InflowTypeData%RotInflow(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InflowTypeData%RotInflow) + end if +end subroutine + +subroutine AD_PackInflowType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AD_InflowType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackInflowType' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%InflowWakeVel) + call RegPack(RF, allocated(InData%RotInflow)) + if (allocated(InData%RotInflow)) then + call RegPackBounds(RF, 1, lbound(InData%RotInflow), ubound(InData%RotInflow)) + LB(1:1) = lbound(InData%RotInflow) + UB(1:1) = ubound(InData%RotInflow) + do i1 = LB(1), UB(1) + call AD_PackRotInflowType(RF, InData%RotInflow(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackInflowType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AD_InflowType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackInflowType' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%InflowWakeVel); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%RotInflow)) deallocate(OutData%RotInflow) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%RotInflow(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotInflow.', RF%ErrStat, RF%ErrMsg, RoutineName) + return end if - DstRotMiscVarTypeData%Y_Twr = SrcRotMiscVarTypeData%Y_Twr + do i1 = LB(1), UB(1) + call AD_UnpackRotInflowType(RF, OutData%RotInflow(i1)) ! RotInflow + end do end if - if (allocated(SrcRotMiscVarTypeData%Cant)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Cant) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Cant) - if (.not. allocated(DstRotMiscVarTypeData%Cant)) then - allocate(DstRotMiscVarTypeData%Cant(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) +end subroutine + +subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotParameterType), intent(in) :: SrcRotParameterTypeData + type(RotParameterType), intent(inout) :: DstRotParameterTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotParameterType' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcRotParameterTypeData%Vars)) then + if (.not. associated(DstRotParameterTypeData%Vars)) then + allocate(DstRotParameterTypeData%Vars, stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Cant.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%Vars.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%Cant = SrcRotMiscVarTypeData%Cant + call NWTC_Library_CopyModVarsType(SrcRotParameterTypeData%Vars, DstRotParameterTypeData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end if - if (allocated(SrcRotMiscVarTypeData%Toe)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Toe) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Toe) - if (.not. allocated(DstRotMiscVarTypeData%Toe)) then - allocate(DstRotMiscVarTypeData%Toe(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + DstRotParameterTypeData%NumBlades = SrcRotParameterTypeData%NumBlades + DstRotParameterTypeData%NumBlNds = SrcRotParameterTypeData%NumBlNds + DstRotParameterTypeData%NumTwrNds = SrcRotParameterTypeData%NumTwrNds + if (allocated(SrcRotParameterTypeData%TwrDiam)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrDiam) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrDiam) + if (.not. allocated(DstRotParameterTypeData%TwrDiam)) then + allocate(DstRotParameterTypeData%TwrDiam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Toe.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDiam.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%Toe = SrcRotMiscVarTypeData%Toe + DstRotParameterTypeData%TwrDiam = SrcRotParameterTypeData%TwrDiam end if - if (allocated(SrcRotMiscVarTypeData%TwrClrnc)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrClrnc) - UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrClrnc) - if (.not. allocated(DstRotMiscVarTypeData%TwrClrnc)) then - allocate(DstRotMiscVarTypeData%TwrClrnc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%TwrCd)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrCd) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrCd) + if (.not. allocated(DstRotParameterTypeData%TwrCd)) then + allocate(DstRotParameterTypeData%TwrCd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrClrnc.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCd.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%TwrClrnc = SrcRotMiscVarTypeData%TwrClrnc + DstRotParameterTypeData%TwrCd = SrcRotParameterTypeData%TwrCd end if - if (allocated(SrcRotMiscVarTypeData%X)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%X) - UB(1:2) = ubound(SrcRotMiscVarTypeData%X) - if (.not. allocated(DstRotMiscVarTypeData%X)) then - allocate(DstRotMiscVarTypeData%X(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%TwrTI)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrTI) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrTI) + if (.not. allocated(DstRotParameterTypeData%TwrTI)) then + allocate(DstRotParameterTypeData%TwrTI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%X.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTI.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%X = SrcRotMiscVarTypeData%X + DstRotParameterTypeData%TwrTI = SrcRotParameterTypeData%TwrTI end if - if (allocated(SrcRotMiscVarTypeData%Y)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Y) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Y) - if (.not. allocated(DstRotMiscVarTypeData%Y)) then - allocate(DstRotMiscVarTypeData%Y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%BlTwist)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlTwist) + UB(1:2) = ubound(SrcRotParameterTypeData%BlTwist) + if (.not. allocated(DstRotParameterTypeData%BlTwist)) then + allocate(DstRotParameterTypeData%BlTwist(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Y.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTwist.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%Y = SrcRotMiscVarTypeData%Y + DstRotParameterTypeData%BlTwist = SrcRotParameterTypeData%BlTwist end if - if (allocated(SrcRotMiscVarTypeData%Z)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Z) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Z) - if (.not. allocated(DstRotMiscVarTypeData%Z)) then - allocate(DstRotMiscVarTypeData%Z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%TwrCb)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrCb) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrCb) + if (.not. allocated(DstRotParameterTypeData%TwrCb)) then + allocate(DstRotParameterTypeData%TwrCb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Z.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCb.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%Z = SrcRotMiscVarTypeData%Z + DstRotParameterTypeData%TwrCb = SrcRotParameterTypeData%TwrCb end if - if (allocated(SrcRotMiscVarTypeData%M)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%M) - UB(1:2) = ubound(SrcRotMiscVarTypeData%M) - if (.not. allocated(DstRotMiscVarTypeData%M)) then - allocate(DstRotMiscVarTypeData%M(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%TwrCp)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrCp) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrCp) + if (.not. allocated(DstRotParameterTypeData%TwrCp)) then + allocate(DstRotParameterTypeData%TwrCp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%M.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCp.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%M = SrcRotMiscVarTypeData%M + DstRotParameterTypeData%TwrCp = SrcRotParameterTypeData%TwrCp end if - if (allocated(SrcRotMiscVarTypeData%Mx)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Mx) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Mx) - if (.not. allocated(DstRotMiscVarTypeData%Mx)) then - allocate(DstRotMiscVarTypeData%Mx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%TwrCa)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrCa) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrCa) + if (.not. allocated(DstRotParameterTypeData%TwrCa)) then + allocate(DstRotParameterTypeData%TwrCa(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Mx.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCa.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%Mx = SrcRotMiscVarTypeData%Mx + DstRotParameterTypeData%TwrCa = SrcRotParameterTypeData%TwrCa end if - if (allocated(SrcRotMiscVarTypeData%My)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%My) - UB(1:2) = ubound(SrcRotMiscVarTypeData%My) - if (.not. allocated(DstRotMiscVarTypeData%My)) then - allocate(DstRotMiscVarTypeData%My(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%BlCenBn)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBn) + UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBn) + if (.not. allocated(DstRotParameterTypeData%BlCenBn)) then + allocate(DstRotParameterTypeData%BlCenBn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%My.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBn.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%My = SrcRotMiscVarTypeData%My + DstRotParameterTypeData%BlCenBn = SrcRotParameterTypeData%BlCenBn end if - if (allocated(SrcRotMiscVarTypeData%Mz)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Mz) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Mz) - if (.not. allocated(DstRotMiscVarTypeData%Mz)) then - allocate(DstRotMiscVarTypeData%Mz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%BlCenBt)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBt) + UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBt) + if (.not. allocated(DstRotParameterTypeData%BlCenBt)) then + allocate(DstRotParameterTypeData%BlCenBt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Mz.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBt.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%Mz = SrcRotMiscVarTypeData%Mz + DstRotParameterTypeData%BlCenBt = SrcRotParameterTypeData%BlCenBt end if - if (allocated(SrcRotMiscVarTypeData%Vind_i)) then - LB(1:3) = lbound(SrcRotMiscVarTypeData%Vind_i) - UB(1:3) = ubound(SrcRotMiscVarTypeData%Vind_i) - if (.not. allocated(DstRotMiscVarTypeData%Vind_i)) then - allocate(DstRotMiscVarTypeData%Vind_i(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + DstRotParameterTypeData%VolHub = SrcRotParameterTypeData%VolHub + DstRotParameterTypeData%HubCenBx = SrcRotParameterTypeData%HubCenBx + DstRotParameterTypeData%VolNac = SrcRotParameterTypeData%VolNac + DstRotParameterTypeData%NacCenB = SrcRotParameterTypeData%NacCenB + DstRotParameterTypeData%NacArea = SrcRotParameterTypeData%NacArea + DstRotParameterTypeData%NacCd = SrcRotParameterTypeData%NacCd + DstRotParameterTypeData%NacDragAC = SrcRotParameterTypeData%NacDragAC + DstRotParameterTypeData%VolBl = SrcRotParameterTypeData%VolBl + DstRotParameterTypeData%VolTwr = SrcRotParameterTypeData%VolTwr + if (allocated(SrcRotParameterTypeData%BlRad)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlRad) + UB(1:2) = ubound(SrcRotParameterTypeData%BlRad) + if (.not. allocated(DstRotParameterTypeData%BlRad)) then + allocate(DstRotParameterTypeData%BlRad(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Vind_i.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlRad.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%Vind_i = SrcRotMiscVarTypeData%Vind_i + DstRotParameterTypeData%BlRad = SrcRotParameterTypeData%BlRad end if - DstRotMiscVarTypeData%V_DiskAvg = SrcRotMiscVarTypeData%V_DiskAvg - DstRotMiscVarTypeData%yaw = SrcRotMiscVarTypeData%yaw - DstRotMiscVarTypeData%tilt = SrcRotMiscVarTypeData%tilt - if (allocated(SrcRotMiscVarTypeData%hub_theta_x_root)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%hub_theta_x_root) - UB(1:1) = ubound(SrcRotMiscVarTypeData%hub_theta_x_root) - if (.not. allocated(DstRotMiscVarTypeData%hub_theta_x_root)) then - allocate(DstRotMiscVarTypeData%hub_theta_x_root(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%BlDL)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlDL) + UB(1:2) = ubound(SrcRotParameterTypeData%BlDL) + if (.not. allocated(DstRotParameterTypeData%BlDL)) then + allocate(DstRotParameterTypeData%BlDL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%hub_theta_x_root.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlDL.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%hub_theta_x_root = SrcRotMiscVarTypeData%hub_theta_x_root + DstRotParameterTypeData%BlDL = SrcRotParameterTypeData%BlDL end if - DstRotMiscVarTypeData%V_dot_x = SrcRotMiscVarTypeData%V_dot_x - call MeshCopy(SrcRotMiscVarTypeData%HubLoad, DstRotMiscVarTypeData%HubLoad, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcRotMiscVarTypeData%B_L_2_H_P)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_H_P) - UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_H_P) - if (.not. allocated(DstRotMiscVarTypeData%B_L_2_H_P)) then - allocate(DstRotMiscVarTypeData%B_L_2_H_P(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%BlTaper)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlTaper) + UB(1:2) = ubound(SrcRotParameterTypeData%BlTaper) + if (.not. allocated(DstRotParameterTypeData%BlTaper)) then + allocate(DstRotParameterTypeData%BlTaper(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_L_2_H_P.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTaper.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%B_L_2_H_P(i1), DstRotMiscVarTypeData%B_L_2_H_P(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstRotParameterTypeData%BlTaper = SrcRotParameterTypeData%BlTaper end if - if (allocated(SrcRotMiscVarTypeData%SigmaCavitCrit)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavitCrit) - UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavitCrit) - if (.not. allocated(DstRotMiscVarTypeData%SigmaCavitCrit)) then - allocate(DstRotMiscVarTypeData%SigmaCavitCrit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%BlAxCent)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlAxCent) + UB(1:2) = ubound(SrcRotParameterTypeData%BlAxCent) + if (.not. allocated(DstRotParameterTypeData%BlAxCent)) then + allocate(DstRotParameterTypeData%BlAxCent(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%SigmaCavitCrit.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlAxCent.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%SigmaCavitCrit = SrcRotMiscVarTypeData%SigmaCavitCrit + DstRotParameterTypeData%BlAxCent = SrcRotParameterTypeData%BlAxCent end if - if (allocated(SrcRotMiscVarTypeData%SigmaCavit)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavit) - UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavit) - if (.not. allocated(DstRotMiscVarTypeData%SigmaCavit)) then - allocate(DstRotMiscVarTypeData%SigmaCavit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%BlIN)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlIN) + UB(1:2) = ubound(SrcRotParameterTypeData%BlIN) + if (.not. allocated(DstRotParameterTypeData%BlIN)) then + allocate(DstRotParameterTypeData%BlIN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%SigmaCavit.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlIN.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%SigmaCavit = SrcRotMiscVarTypeData%SigmaCavit + DstRotParameterTypeData%BlIN = SrcRotParameterTypeData%BlIN end if - if (allocated(SrcRotMiscVarTypeData%CavitWarnSet)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%CavitWarnSet) - UB(1:2) = ubound(SrcRotMiscVarTypeData%CavitWarnSet) - if (.not. allocated(DstRotMiscVarTypeData%CavitWarnSet)) then - allocate(DstRotMiscVarTypeData%CavitWarnSet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%BlIT)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlIT) + UB(1:2) = ubound(SrcRotParameterTypeData%BlIT) + if (.not. allocated(DstRotParameterTypeData%BlIT)) then + allocate(DstRotParameterTypeData%BlIT(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%CavitWarnSet.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlIT.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%CavitWarnSet = SrcRotMiscVarTypeData%CavitWarnSet + DstRotParameterTypeData%BlIT = SrcRotParameterTypeData%BlIT end if - if (allocated(SrcRotMiscVarTypeData%TwrFB)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrFB) - UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrFB) - if (.not. allocated(DstRotMiscVarTypeData%TwrFB)) then - allocate(DstRotMiscVarTypeData%TwrFB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%BlAN)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlAN) + UB(1:2) = ubound(SrcRotParameterTypeData%BlAN) + if (.not. allocated(DstRotParameterTypeData%BlAN)) then + allocate(DstRotParameterTypeData%BlAN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrFB.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlAN.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%TwrFB = SrcRotMiscVarTypeData%TwrFB + DstRotParameterTypeData%BlAN = SrcRotParameterTypeData%BlAN end if - if (allocated(SrcRotMiscVarTypeData%TwrMB)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrMB) - UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrMB) - if (.not. allocated(DstRotMiscVarTypeData%TwrMB)) then - allocate(DstRotMiscVarTypeData%TwrMB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%BlAT)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlAT) + UB(1:2) = ubound(SrcRotParameterTypeData%BlAT) + if (.not. allocated(DstRotParameterTypeData%BlAT)) then + allocate(DstRotParameterTypeData%BlAT(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrMB.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlAT.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%TwrMB = SrcRotMiscVarTypeData%TwrMB + DstRotParameterTypeData%BlAT = SrcRotParameterTypeData%BlAT end if - if (allocated(SrcRotMiscVarTypeData%HubFB)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%HubFB) - UB(1:1) = ubound(SrcRotMiscVarTypeData%HubFB) - if (.not. allocated(DstRotMiscVarTypeData%HubFB)) then - allocate(DstRotMiscVarTypeData%HubFB(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%BlAM)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlAM) + UB(1:2) = ubound(SrcRotParameterTypeData%BlAM) + if (.not. allocated(DstRotParameterTypeData%BlAM)) then + allocate(DstRotParameterTypeData%BlAM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%HubFB.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlAM.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%HubFB = SrcRotMiscVarTypeData%HubFB + DstRotParameterTypeData%BlAM = SrcRotParameterTypeData%BlAM end if - if (allocated(SrcRotMiscVarTypeData%HubMB)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%HubMB) - UB(1:1) = ubound(SrcRotMiscVarTypeData%HubMB) - if (.not. allocated(DstRotMiscVarTypeData%HubMB)) then - allocate(DstRotMiscVarTypeData%HubMB(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%TwrRad)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrRad) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrRad) + if (.not. allocated(DstRotParameterTypeData%TwrRad)) then + allocate(DstRotParameterTypeData%TwrRad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%HubMB.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrRad.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%HubMB = SrcRotMiscVarTypeData%HubMB + DstRotParameterTypeData%TwrRad = SrcRotParameterTypeData%TwrRad end if - if (allocated(SrcRotMiscVarTypeData%NacFB)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%NacFB) - UB(1:1) = ubound(SrcRotMiscVarTypeData%NacFB) - if (.not. allocated(DstRotMiscVarTypeData%NacFB)) then - allocate(DstRotMiscVarTypeData%NacFB(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%TwrDL)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrDL) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrDL) + if (.not. allocated(DstRotParameterTypeData%TwrDL)) then + allocate(DstRotParameterTypeData%TwrDL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacFB.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDL.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%NacFB = SrcRotMiscVarTypeData%NacFB + DstRotParameterTypeData%TwrDL = SrcRotParameterTypeData%TwrDL end if - if (allocated(SrcRotMiscVarTypeData%NacMB)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%NacMB) - UB(1:1) = ubound(SrcRotMiscVarTypeData%NacMB) - if (.not. allocated(DstRotMiscVarTypeData%NacMB)) then - allocate(DstRotMiscVarTypeData%NacMB(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%TwrTaper)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrTaper) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrTaper) + if (.not. allocated(DstRotParameterTypeData%TwrTaper)) then + allocate(DstRotParameterTypeData%TwrTaper(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacMB.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTaper.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%NacMB = SrcRotMiscVarTypeData%NacMB + DstRotParameterTypeData%TwrTaper = SrcRotParameterTypeData%TwrTaper end if - if (allocated(SrcRotMiscVarTypeData%NacDragF)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%NacDragF) - UB(1:1) = ubound(SrcRotMiscVarTypeData%NacDragF) - if (.not. allocated(DstRotMiscVarTypeData%NacDragF)) then - allocate(DstRotMiscVarTypeData%NacDragF(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%TwrAxCent)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrAxCent) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrAxCent) + if (.not. allocated(DstRotParameterTypeData%TwrAxCent)) then + allocate(DstRotParameterTypeData%TwrAxCent(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacDragF.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrAxCent.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%NacDragF = SrcRotMiscVarTypeData%NacDragF + DstRotParameterTypeData%TwrAxCent = SrcRotParameterTypeData%TwrAxCent end if - if (allocated(SrcRotMiscVarTypeData%NacDragM)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%NacDragM) - UB(1:1) = ubound(SrcRotMiscVarTypeData%NacDragM) - if (.not. allocated(DstRotMiscVarTypeData%NacDragM)) then - allocate(DstRotMiscVarTypeData%NacDragM(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%TwrIT)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrIT) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrIT) + if (.not. allocated(DstRotParameterTypeData%TwrIT)) then + allocate(DstRotParameterTypeData%TwrIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacDragM.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrIT.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%NacDragM = SrcRotMiscVarTypeData%NacDragM + DstRotParameterTypeData%TwrIT = SrcRotParameterTypeData%TwrIT end if - if (allocated(SrcRotMiscVarTypeData%NacFi)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%NacFi) - UB(1:1) = ubound(SrcRotMiscVarTypeData%NacFi) - if (.not. allocated(DstRotMiscVarTypeData%NacFi)) then - allocate(DstRotMiscVarTypeData%NacFi(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%TwrAT)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrAT) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrAT) + if (.not. allocated(DstRotParameterTypeData%TwrAT)) then + allocate(DstRotParameterTypeData%TwrAT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacFi.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrAT.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%NacFi = SrcRotMiscVarTypeData%NacFi + DstRotParameterTypeData%TwrAT = SrcRotParameterTypeData%TwrAT end if - if (allocated(SrcRotMiscVarTypeData%NacMi)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%NacMi) - UB(1:1) = ubound(SrcRotMiscVarTypeData%NacMi) - if (.not. allocated(DstRotMiscVarTypeData%NacMi)) then - allocate(DstRotMiscVarTypeData%NacMi(LB(1):UB(1)), stat=ErrStat2) + call BEMT_CopyParam(SrcRotParameterTypeData%BEMT, DstRotParameterTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyParam(SrcRotParameterTypeData%AA, DstRotParameterTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstRotParameterTypeData%NumExtendedInputs = SrcRotParameterTypeData%NumExtendedInputs + if (allocated(SrcRotParameterTypeData%du)) then + LB(1:1) = lbound(SrcRotParameterTypeData%du) + UB(1:1) = ubound(SrcRotParameterTypeData%du) + if (.not. allocated(DstRotParameterTypeData%du)) then + allocate(DstRotParameterTypeData%du(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacMi.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%du.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%NacMi = SrcRotMiscVarTypeData%NacMi + DstRotParameterTypeData%du = SrcRotParameterTypeData%du end if - if (allocated(SrcRotMiscVarTypeData%BladeRootLoad)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeRootLoad) - UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeRootLoad) - if (.not. allocated(DstRotMiscVarTypeData%BladeRootLoad)) then - allocate(DstRotMiscVarTypeData%BladeRootLoad(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%dx)) then + LB(1:1) = lbound(SrcRotParameterTypeData%dx) + UB(1:1) = ubound(SrcRotParameterTypeData%dx) + if (.not. allocated(DstRotParameterTypeData%dx)) then + allocate(DstRotParameterTypeData%dx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeRootLoad.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%dx.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MeshCopy(SrcRotMiscVarTypeData%BladeRootLoad(i1), DstRotMiscVarTypeData%BladeRootLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstRotParameterTypeData%dx = SrcRotParameterTypeData%dx end if - if (allocated(SrcRotMiscVarTypeData%B_L_2_R_P)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_R_P) - UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_R_P) - if (.not. allocated(DstRotMiscVarTypeData%B_L_2_R_P)) then - allocate(DstRotMiscVarTypeData%B_L_2_R_P(LB(1):UB(1)), stat=ErrStat2) + DstRotParameterTypeData%Jac_ny = SrcRotParameterTypeData%Jac_ny + DstRotParameterTypeData%NumBl_Lin = SrcRotParameterTypeData%NumBl_Lin + DstRotParameterTypeData%TwrPotent = SrcRotParameterTypeData%TwrPotent + DstRotParameterTypeData%TwrShadow = SrcRotParameterTypeData%TwrShadow + DstRotParameterTypeData%TwrAero = SrcRotParameterTypeData%TwrAero + DstRotParameterTypeData%DBEMT_Mod = SrcRotParameterTypeData%DBEMT_Mod + DstRotParameterTypeData%CavitCheck = SrcRotParameterTypeData%CavitCheck + DstRotParameterTypeData%NacelleDrag = SrcRotParameterTypeData%NacelleDrag + DstRotParameterTypeData%MHK = SrcRotParameterTypeData%MHK + DstRotParameterTypeData%CompAA = SrcRotParameterTypeData%CompAA + DstRotParameterTypeData%AirDens = SrcRotParameterTypeData%AirDens + DstRotParameterTypeData%KinVisc = SrcRotParameterTypeData%KinVisc + DstRotParameterTypeData%SpdSound = SrcRotParameterTypeData%SpdSound + DstRotParameterTypeData%Gravity = SrcRotParameterTypeData%Gravity + DstRotParameterTypeData%Patm = SrcRotParameterTypeData%Patm + DstRotParameterTypeData%Pvap = SrcRotParameterTypeData%Pvap + DstRotParameterTypeData%WtrDpth = SrcRotParameterTypeData%WtrDpth + DstRotParameterTypeData%MSL2SWL = SrcRotParameterTypeData%MSL2SWL + DstRotParameterTypeData%AeroProjMod = SrcRotParameterTypeData%AeroProjMod + DstRotParameterTypeData%BEM_Mod = SrcRotParameterTypeData%BEM_Mod + DstRotParameterTypeData%NumOuts = SrcRotParameterTypeData%NumOuts + DstRotParameterTypeData%RootName = SrcRotParameterTypeData%RootName + if (allocated(SrcRotParameterTypeData%OutParam)) then + LB(1:1) = lbound(SrcRotParameterTypeData%OutParam) + UB(1:1) = ubound(SrcRotParameterTypeData%OutParam) + if (.not. allocated(DstRotParameterTypeData%OutParam)) then + allocate(DstRotParameterTypeData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_L_2_R_P.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%OutParam.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%B_L_2_R_P(i1), DstRotMiscVarTypeData%B_L_2_R_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyOutParmType(SrcRotParameterTypeData%OutParam(i1), DstRotParameterTypeData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcRotMiscVarTypeData%BladeBuoyLoadPoint)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint) - UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint) - if (.not. allocated(DstRotMiscVarTypeData%BladeBuoyLoadPoint)) then - allocate(DstRotMiscVarTypeData%BladeBuoyLoadPoint(LB(1):UB(1)), stat=ErrStat2) + DstRotParameterTypeData%NBlOuts = SrcRotParameterTypeData%NBlOuts + DstRotParameterTypeData%BlOutNd = SrcRotParameterTypeData%BlOutNd + DstRotParameterTypeData%NTwOuts = SrcRotParameterTypeData%NTwOuts + DstRotParameterTypeData%TwOutNd = SrcRotParameterTypeData%TwOutNd + DstRotParameterTypeData%BldNd_NumOuts = SrcRotParameterTypeData%BldNd_NumOuts + DstRotParameterTypeData%BldNd_TotNumOuts = SrcRotParameterTypeData%BldNd_TotNumOuts + if (allocated(SrcRotParameterTypeData%BldNd_OutParam)) then + LB(1:1) = lbound(SrcRotParameterTypeData%BldNd_OutParam) + UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_OutParam) + if (.not. allocated(DstRotParameterTypeData%BldNd_OutParam)) then + allocate(DstRotParameterTypeData%BldNd_OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoadPoint.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BldNd_OutParam.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MeshCopy(SrcRotMiscVarTypeData%BladeBuoyLoadPoint(i1), DstRotMiscVarTypeData%BladeBuoyLoadPoint(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call NWTC_Library_CopyOutParmType(SrcRotParameterTypeData%BldNd_OutParam(i1), DstRotParameterTypeData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcRotMiscVarTypeData%BladeBuoyLoad)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoad) - UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoad) - if (.not. allocated(DstRotMiscVarTypeData%BladeBuoyLoad)) then - allocate(DstRotMiscVarTypeData%BladeBuoyLoad(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotParameterTypeData%BldNd_BlOutNd)) then + LB(1:1) = lbound(SrcRotParameterTypeData%BldNd_BlOutNd) + UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_BlOutNd) + if (.not. allocated(DstRotParameterTypeData%BldNd_BlOutNd)) then + allocate(DstRotParameterTypeData%BldNd_BlOutNd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoad.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BldNd_BlOutNd.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MeshCopy(SrcRotMiscVarTypeData%BladeBuoyLoad(i1), DstRotMiscVarTypeData%BladeBuoyLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstRotParameterTypeData%BldNd_BlOutNd = SrcRotParameterTypeData%BldNd_BlOutNd end if - if (allocated(SrcRotMiscVarTypeData%B_P_2_B_L)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%B_P_2_B_L) - UB(1:1) = ubound(SrcRotMiscVarTypeData%B_P_2_B_L) - if (.not. allocated(DstRotMiscVarTypeData%B_P_2_B_L)) then - allocate(DstRotMiscVarTypeData%B_P_2_B_L(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_P_2_B_L.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%B_P_2_B_L(i1), DstRotMiscVarTypeData%B_P_2_B_L(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - call MeshCopy(SrcRotMiscVarTypeData%TwrBuoyLoadPoint, DstRotMiscVarTypeData%TwrBuoyLoadPoint, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcRotMiscVarTypeData%TwrBuoyLoad, DstRotMiscVarTypeData%TwrBuoyLoad, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%T_P_2_T_L, DstRotMiscVarTypeData%T_P_2_T_L, CtrlCode, ErrStat2, ErrMsg2) + DstRotParameterTypeData%BldNd_BladesOut = SrcRotParameterTypeData%BldNd_BladesOut + DstRotParameterTypeData%BldNd_NumNodesOut = SrcRotParameterTypeData%BldNd_NumNodesOut + DstRotParameterTypeData%TFinAero = SrcRotParameterTypeData%TFinAero + call AD_CopyTFinParameterType(SrcRotParameterTypeData%TFin, DstRotParameterTypeData%TFin, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - DstRotMiscVarTypeData%FirstWarn_TowerStrike = SrcRotMiscVarTypeData%FirstWarn_TowerStrike - DstRotMiscVarTypeData%AvgDiskVel = SrcRotMiscVarTypeData%AvgDiskVel - DstRotMiscVarTypeData%AvgDiskVelDist = SrcRotMiscVarTypeData%AvgDiskVelDist - DstRotMiscVarTypeData%TFinAlpha = SrcRotMiscVarTypeData%TFinAlpha - DstRotMiscVarTypeData%TFinRe = SrcRotMiscVarTypeData%TFinRe - DstRotMiscVarTypeData%TFinVrel = SrcRotMiscVarTypeData%TFinVrel - DstRotMiscVarTypeData%TFinVund_i = SrcRotMiscVarTypeData%TFinVund_i - DstRotMiscVarTypeData%TFinVind_i = SrcRotMiscVarTypeData%TFinVind_i - DstRotMiscVarTypeData%TFinVrel_i = SrcRotMiscVarTypeData%TFinVrel_i - DstRotMiscVarTypeData%TFinSTV_i = SrcRotMiscVarTypeData%TFinSTV_i - DstRotMiscVarTypeData%TFinF_i = SrcRotMiscVarTypeData%TFinF_i - DstRotMiscVarTypeData%TFinM_i = SrcRotMiscVarTypeData%TFinM_i end subroutine -subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) - type(RotMiscVarType), intent(inout) :: RotMiscVarTypeData +subroutine AD_DestroyRotParameterType(RotParameterTypeData, ErrStat, ErrMsg) + type(RotParameterType), intent(inout) :: RotParameterTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2, i3, i4 - integer(B4Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_DestroyRotMiscVarType' + character(*), parameter :: RoutineName = 'AD_DestroyRotParameterType' ErrStat = ErrID_None ErrMsg = '' - call BEMT_DestroyMisc(RotMiscVarTypeData%BEMT, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call BEMT_DestroyOutput(RotMiscVarTypeData%BEMT_y, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - LB(1:1) = lbound(RotMiscVarTypeData%BEMT_u) - UB(1:1) = ubound(RotMiscVarTypeData%BEMT_u) - do i1 = LB(1), UB(1) - call BEMT_DestroyInput(RotMiscVarTypeData%BEMT_u(i1), ErrStat2, ErrMsg2) + if (associated(RotParameterTypeData%Vars)) then + call NWTC_Library_DestroyModVarsType(RotParameterTypeData%Vars, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - call AA_DestroyMisc(RotMiscVarTypeData%AA, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AA_DestroyOutput(RotMiscVarTypeData%AA_y, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AA_DestroyInput(RotMiscVarTypeData%AA_u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(RotMiscVarTypeData%DisturbedInflow)) then - deallocate(RotMiscVarTypeData%DisturbedInflow) - end if - if (allocated(RotMiscVarTypeData%SectAvgInflow)) then - deallocate(RotMiscVarTypeData%SectAvgInflow) - end if - if (allocated(RotMiscVarTypeData%orientationAnnulus)) then - deallocate(RotMiscVarTypeData%orientationAnnulus) - end if - if (allocated(RotMiscVarTypeData%R_li)) then - deallocate(RotMiscVarTypeData%R_li) - end if - if (allocated(RotMiscVarTypeData%AllOuts)) then - deallocate(RotMiscVarTypeData%AllOuts) - end if - if (allocated(RotMiscVarTypeData%W_Twr)) then - deallocate(RotMiscVarTypeData%W_Twr) - end if - if (allocated(RotMiscVarTypeData%X_Twr)) then - deallocate(RotMiscVarTypeData%X_Twr) - end if - if (allocated(RotMiscVarTypeData%Y_Twr)) then - deallocate(RotMiscVarTypeData%Y_Twr) - end if - if (allocated(RotMiscVarTypeData%Cant)) then - deallocate(RotMiscVarTypeData%Cant) - end if - if (allocated(RotMiscVarTypeData%Toe)) then - deallocate(RotMiscVarTypeData%Toe) + deallocate(RotParameterTypeData%Vars) + RotParameterTypeData%Vars => null() end if - if (allocated(RotMiscVarTypeData%TwrClrnc)) then - deallocate(RotMiscVarTypeData%TwrClrnc) + if (allocated(RotParameterTypeData%TwrDiam)) then + deallocate(RotParameterTypeData%TwrDiam) end if - if (allocated(RotMiscVarTypeData%X)) then - deallocate(RotMiscVarTypeData%X) + if (allocated(RotParameterTypeData%TwrCd)) then + deallocate(RotParameterTypeData%TwrCd) end if - if (allocated(RotMiscVarTypeData%Y)) then - deallocate(RotMiscVarTypeData%Y) + if (allocated(RotParameterTypeData%TwrTI)) then + deallocate(RotParameterTypeData%TwrTI) end if - if (allocated(RotMiscVarTypeData%Z)) then - deallocate(RotMiscVarTypeData%Z) + if (allocated(RotParameterTypeData%BlTwist)) then + deallocate(RotParameterTypeData%BlTwist) end if - if (allocated(RotMiscVarTypeData%M)) then - deallocate(RotMiscVarTypeData%M) + if (allocated(RotParameterTypeData%TwrCb)) then + deallocate(RotParameterTypeData%TwrCb) end if - if (allocated(RotMiscVarTypeData%Mx)) then - deallocate(RotMiscVarTypeData%Mx) + if (allocated(RotParameterTypeData%TwrCp)) then + deallocate(RotParameterTypeData%TwrCp) end if - if (allocated(RotMiscVarTypeData%My)) then - deallocate(RotMiscVarTypeData%My) + if (allocated(RotParameterTypeData%TwrCa)) then + deallocate(RotParameterTypeData%TwrCa) end if - if (allocated(RotMiscVarTypeData%Mz)) then - deallocate(RotMiscVarTypeData%Mz) + if (allocated(RotParameterTypeData%BlCenBn)) then + deallocate(RotParameterTypeData%BlCenBn) end if - if (allocated(RotMiscVarTypeData%Vind_i)) then - deallocate(RotMiscVarTypeData%Vind_i) + if (allocated(RotParameterTypeData%BlCenBt)) then + deallocate(RotParameterTypeData%BlCenBt) end if - if (allocated(RotMiscVarTypeData%hub_theta_x_root)) then - deallocate(RotMiscVarTypeData%hub_theta_x_root) + if (allocated(RotParameterTypeData%BlRad)) then + deallocate(RotParameterTypeData%BlRad) end if - call MeshDestroy( RotMiscVarTypeData%HubLoad, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(RotMiscVarTypeData%B_L_2_H_P)) then - LB(1:1) = lbound(RotMiscVarTypeData%B_L_2_H_P) - UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_H_P) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_L_2_H_P(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(RotMiscVarTypeData%B_L_2_H_P) + if (allocated(RotParameterTypeData%BlDL)) then + deallocate(RotParameterTypeData%BlDL) end if - if (allocated(RotMiscVarTypeData%SigmaCavitCrit)) then - deallocate(RotMiscVarTypeData%SigmaCavitCrit) + if (allocated(RotParameterTypeData%BlTaper)) then + deallocate(RotParameterTypeData%BlTaper) end if - if (allocated(RotMiscVarTypeData%SigmaCavit)) then - deallocate(RotMiscVarTypeData%SigmaCavit) + if (allocated(RotParameterTypeData%BlAxCent)) then + deallocate(RotParameterTypeData%BlAxCent) end if - if (allocated(RotMiscVarTypeData%CavitWarnSet)) then - deallocate(RotMiscVarTypeData%CavitWarnSet) + if (allocated(RotParameterTypeData%BlIN)) then + deallocate(RotParameterTypeData%BlIN) end if - if (allocated(RotMiscVarTypeData%TwrFB)) then - deallocate(RotMiscVarTypeData%TwrFB) + if (allocated(RotParameterTypeData%BlIT)) then + deallocate(RotParameterTypeData%BlIT) end if - if (allocated(RotMiscVarTypeData%TwrMB)) then - deallocate(RotMiscVarTypeData%TwrMB) + if (allocated(RotParameterTypeData%BlAN)) then + deallocate(RotParameterTypeData%BlAN) end if - if (allocated(RotMiscVarTypeData%HubFB)) then - deallocate(RotMiscVarTypeData%HubFB) + if (allocated(RotParameterTypeData%BlAT)) then + deallocate(RotParameterTypeData%BlAT) end if - if (allocated(RotMiscVarTypeData%HubMB)) then - deallocate(RotMiscVarTypeData%HubMB) + if (allocated(RotParameterTypeData%BlAM)) then + deallocate(RotParameterTypeData%BlAM) end if - if (allocated(RotMiscVarTypeData%NacFB)) then - deallocate(RotMiscVarTypeData%NacFB) + if (allocated(RotParameterTypeData%TwrRad)) then + deallocate(RotParameterTypeData%TwrRad) end if - if (allocated(RotMiscVarTypeData%NacMB)) then - deallocate(RotMiscVarTypeData%NacMB) + if (allocated(RotParameterTypeData%TwrDL)) then + deallocate(RotParameterTypeData%TwrDL) end if - if (allocated(RotMiscVarTypeData%NacDragF)) then - deallocate(RotMiscVarTypeData%NacDragF) + if (allocated(RotParameterTypeData%TwrTaper)) then + deallocate(RotParameterTypeData%TwrTaper) end if - if (allocated(RotMiscVarTypeData%NacDragM)) then - deallocate(RotMiscVarTypeData%NacDragM) + if (allocated(RotParameterTypeData%TwrAxCent)) then + deallocate(RotParameterTypeData%TwrAxCent) end if - if (allocated(RotMiscVarTypeData%NacFi)) then - deallocate(RotMiscVarTypeData%NacFi) + if (allocated(RotParameterTypeData%TwrIT)) then + deallocate(RotParameterTypeData%TwrIT) end if - if (allocated(RotMiscVarTypeData%NacMi)) then - deallocate(RotMiscVarTypeData%NacMi) + if (allocated(RotParameterTypeData%TwrAT)) then + deallocate(RotParameterTypeData%TwrAT) end if - if (allocated(RotMiscVarTypeData%BladeRootLoad)) then - LB(1:1) = lbound(RotMiscVarTypeData%BladeRootLoad) - UB(1:1) = ubound(RotMiscVarTypeData%BladeRootLoad) - do i1 = LB(1), UB(1) - call MeshDestroy( RotMiscVarTypeData%BladeRootLoad(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(RotMiscVarTypeData%BladeRootLoad) + call BEMT_DestroyParam(RotParameterTypeData%BEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyParam(RotParameterTypeData%AA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotParameterTypeData%du)) then + deallocate(RotParameterTypeData%du) end if - if (allocated(RotMiscVarTypeData%B_L_2_R_P)) then - LB(1:1) = lbound(RotMiscVarTypeData%B_L_2_R_P) - UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_R_P) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_L_2_R_P(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(RotMiscVarTypeData%B_L_2_R_P) + if (allocated(RotParameterTypeData%dx)) then + deallocate(RotParameterTypeData%dx) end if - if (allocated(RotMiscVarTypeData%BladeBuoyLoadPoint)) then - LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoadPoint) - UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoadPoint) + if (allocated(RotParameterTypeData%OutParam)) then + LB(1:1) = lbound(RotParameterTypeData%OutParam) + UB(1:1) = ubound(RotParameterTypeData%OutParam) do i1 = LB(1), UB(1) - call MeshDestroy( RotMiscVarTypeData%BladeBuoyLoadPoint(i1), ErrStat2, ErrMsg2) + call NWTC_Library_DestroyOutParmType(RotParameterTypeData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(RotMiscVarTypeData%BladeBuoyLoadPoint) + deallocate(RotParameterTypeData%OutParam) end if - if (allocated(RotMiscVarTypeData%BladeBuoyLoad)) then - LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoad) - UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoad) + if (allocated(RotParameterTypeData%BldNd_OutParam)) then + LB(1:1) = lbound(RotParameterTypeData%BldNd_OutParam) + UB(1:1) = ubound(RotParameterTypeData%BldNd_OutParam) do i1 = LB(1), UB(1) - call MeshDestroy( RotMiscVarTypeData%BladeBuoyLoad(i1), ErrStat2, ErrMsg2) + call NWTC_Library_DestroyOutParmType(RotParameterTypeData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(RotMiscVarTypeData%BladeBuoyLoad) + deallocate(RotParameterTypeData%BldNd_OutParam) end if - if (allocated(RotMiscVarTypeData%B_P_2_B_L)) then - LB(1:1) = lbound(RotMiscVarTypeData%B_P_2_B_L) - UB(1:1) = ubound(RotMiscVarTypeData%B_P_2_B_L) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_P_2_B_L(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(RotMiscVarTypeData%B_P_2_B_L) + if (allocated(RotParameterTypeData%BldNd_BlOutNd)) then + deallocate(RotParameterTypeData%BldNd_BlOutNd) end if - call MeshDestroy( RotMiscVarTypeData%TwrBuoyLoadPoint, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( RotMiscVarTypeData%TwrBuoyLoad, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%T_P_2_T_L, ErrStat2, ErrMsg2) + call AD_DestroyTFinParameterType(RotParameterTypeData%TFin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD_PackRotMiscVarType(RF, Indata) +subroutine AD_PackRotParameterType(RF, Indata) type(RegFile), intent(inout) :: RF - type(RotMiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackRotMiscVarType' - integer(B4Ki) :: i1, i2, i3, i4 - integer(B4Ki) :: LB(4), UB(4) + type(RotParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotParameterType' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - call BEMT_PackMisc(RF, InData%BEMT) - call BEMT_PackOutput(RF, InData%BEMT_y) - LB(1:1) = lbound(InData%BEMT_u) - UB(1:1) = ubound(InData%BEMT_u) - do i1 = LB(1), UB(1) - call BEMT_PackInput(RF, InData%BEMT_u(i1)) - end do - call AA_PackMisc(RF, InData%AA) - call AA_PackOutput(RF, InData%AA_y) - call AA_PackInput(RF, InData%AA_u) - call RegPackAlloc(RF, InData%DisturbedInflow) - call RegPackAlloc(RF, InData%SectAvgInflow) - call RegPackAlloc(RF, InData%orientationAnnulus) - call RegPackAlloc(RF, InData%R_li) - call RegPackAlloc(RF, InData%AllOuts) - call RegPackAlloc(RF, InData%W_Twr) - call RegPackAlloc(RF, InData%X_Twr) - call RegPackAlloc(RF, InData%Y_Twr) - call RegPackAlloc(RF, InData%Cant) - call RegPackAlloc(RF, InData%Toe) - call RegPackAlloc(RF, InData%TwrClrnc) - call RegPackAlloc(RF, InData%X) - call RegPackAlloc(RF, InData%Y) - call RegPackAlloc(RF, InData%Z) - call RegPackAlloc(RF, InData%M) - call RegPackAlloc(RF, InData%Mx) - call RegPackAlloc(RF, InData%My) - call RegPackAlloc(RF, InData%Mz) - call RegPackAlloc(RF, InData%Vind_i) - call RegPack(RF, InData%V_DiskAvg) - call RegPack(RF, InData%yaw) - call RegPack(RF, InData%tilt) - call RegPackAlloc(RF, InData%hub_theta_x_root) - call RegPack(RF, InData%V_dot_x) - call MeshPack(RF, InData%HubLoad) - call RegPack(RF, allocated(InData%B_L_2_H_P)) - if (allocated(InData%B_L_2_H_P)) then - call RegPackBounds(RF, 1, lbound(InData%B_L_2_H_P), ubound(InData%B_L_2_H_P)) - LB(1:1) = lbound(InData%B_L_2_H_P) - UB(1:1) = ubound(InData%B_L_2_H_P) - do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(RF, InData%B_L_2_H_P(i1)) - end do - end if - call RegPackAlloc(RF, InData%SigmaCavitCrit) - call RegPackAlloc(RF, InData%SigmaCavit) - call RegPackAlloc(RF, InData%CavitWarnSet) - call RegPackAlloc(RF, InData%TwrFB) - call RegPackAlloc(RF, InData%TwrMB) - call RegPackAlloc(RF, InData%HubFB) - call RegPackAlloc(RF, InData%HubMB) - call RegPackAlloc(RF, InData%NacFB) - call RegPackAlloc(RF, InData%NacMB) - call RegPackAlloc(RF, InData%NacDragF) - call RegPackAlloc(RF, InData%NacDragM) - call RegPackAlloc(RF, InData%NacFi) - call RegPackAlloc(RF, InData%NacMi) - call RegPack(RF, allocated(InData%BladeRootLoad)) - if (allocated(InData%BladeRootLoad)) then - call RegPackBounds(RF, 1, lbound(InData%BladeRootLoad), ubound(InData%BladeRootLoad)) - LB(1:1) = lbound(InData%BladeRootLoad) - UB(1:1) = ubound(InData%BladeRootLoad) - do i1 = LB(1), UB(1) - call MeshPack(RF, InData%BladeRootLoad(i1)) - end do - end if - call RegPack(RF, allocated(InData%B_L_2_R_P)) - if (allocated(InData%B_L_2_R_P)) then - call RegPackBounds(RF, 1, lbound(InData%B_L_2_R_P), ubound(InData%B_L_2_R_P)) - LB(1:1) = lbound(InData%B_L_2_R_P) - UB(1:1) = ubound(InData%B_L_2_R_P) - do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(RF, InData%B_L_2_R_P(i1)) - end do - end if - call RegPack(RF, allocated(InData%BladeBuoyLoadPoint)) - if (allocated(InData%BladeBuoyLoadPoint)) then - call RegPackBounds(RF, 1, lbound(InData%BladeBuoyLoadPoint), ubound(InData%BladeBuoyLoadPoint)) - LB(1:1) = lbound(InData%BladeBuoyLoadPoint) - UB(1:1) = ubound(InData%BladeBuoyLoadPoint) - do i1 = LB(1), UB(1) - call MeshPack(RF, InData%BladeBuoyLoadPoint(i1)) - end do + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if end if - call RegPack(RF, allocated(InData%BladeBuoyLoad)) - if (allocated(InData%BladeBuoyLoad)) then - call RegPackBounds(RF, 1, lbound(InData%BladeBuoyLoad), ubound(InData%BladeBuoyLoad)) - LB(1:1) = lbound(InData%BladeBuoyLoad) - UB(1:1) = ubound(InData%BladeBuoyLoad) + call RegPack(RF, InData%NumBlades) + call RegPack(RF, InData%NumBlNds) + call RegPack(RF, InData%NumTwrNds) + call RegPackAlloc(RF, InData%TwrDiam) + call RegPackAlloc(RF, InData%TwrCd) + call RegPackAlloc(RF, InData%TwrTI) + call RegPackAlloc(RF, InData%BlTwist) + call RegPackAlloc(RF, InData%TwrCb) + call RegPackAlloc(RF, InData%TwrCp) + call RegPackAlloc(RF, InData%TwrCa) + call RegPackAlloc(RF, InData%BlCenBn) + call RegPackAlloc(RF, InData%BlCenBt) + call RegPack(RF, InData%VolHub) + call RegPack(RF, InData%HubCenBx) + call RegPack(RF, InData%VolNac) + call RegPack(RF, InData%NacCenB) + call RegPack(RF, InData%NacArea) + call RegPack(RF, InData%NacCd) + call RegPack(RF, InData%NacDragAC) + call RegPack(RF, InData%VolBl) + call RegPack(RF, InData%VolTwr) + call RegPackAlloc(RF, InData%BlRad) + call RegPackAlloc(RF, InData%BlDL) + call RegPackAlloc(RF, InData%BlTaper) + call RegPackAlloc(RF, InData%BlAxCent) + call RegPackAlloc(RF, InData%BlIN) + call RegPackAlloc(RF, InData%BlIT) + call RegPackAlloc(RF, InData%BlAN) + call RegPackAlloc(RF, InData%BlAT) + call RegPackAlloc(RF, InData%BlAM) + call RegPackAlloc(RF, InData%TwrRad) + call RegPackAlloc(RF, InData%TwrDL) + call RegPackAlloc(RF, InData%TwrTaper) + call RegPackAlloc(RF, InData%TwrAxCent) + call RegPackAlloc(RF, InData%TwrIT) + call RegPackAlloc(RF, InData%TwrAT) + call BEMT_PackParam(RF, InData%BEMT) + call AA_PackParam(RF, InData%AA) + call RegPack(RF, InData%NumExtendedInputs) + call RegPackAlloc(RF, InData%du) + call RegPackAlloc(RF, InData%dx) + call RegPack(RF, InData%Jac_ny) + call RegPack(RF, InData%NumBl_Lin) + call RegPack(RF, InData%TwrPotent) + call RegPack(RF, InData%TwrShadow) + call RegPack(RF, InData%TwrAero) + call RegPack(RF, InData%DBEMT_Mod) + call RegPack(RF, InData%CavitCheck) + call RegPack(RF, InData%NacelleDrag) + call RegPack(RF, InData%MHK) + call RegPack(RF, InData%CompAA) + call RegPack(RF, InData%AirDens) + call RegPack(RF, InData%KinVisc) + call RegPack(RF, InData%SpdSound) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%Patm) + call RegPack(RF, InData%Pvap) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%MSL2SWL) + call RegPack(RF, InData%AeroProjMod) + call RegPack(RF, InData%BEM_Mod) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%RootName) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%BladeBuoyLoad(i1)) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do end if - call RegPack(RF, allocated(InData%B_P_2_B_L)) - if (allocated(InData%B_P_2_B_L)) then - call RegPackBounds(RF, 1, lbound(InData%B_P_2_B_L), ubound(InData%B_P_2_B_L)) - LB(1:1) = lbound(InData%B_P_2_B_L) - UB(1:1) = ubound(InData%B_P_2_B_L) + call RegPack(RF, InData%NBlOuts) + call RegPack(RF, InData%BlOutNd) + call RegPack(RF, InData%NTwOuts) + call RegPack(RF, InData%TwOutNd) + call RegPack(RF, InData%BldNd_NumOuts) + call RegPack(RF, InData%BldNd_TotNumOuts) + call RegPack(RF, allocated(InData%BldNd_OutParam)) + if (allocated(InData%BldNd_OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%BldNd_OutParam), ubound(InData%BldNd_OutParam)) + LB(1:1) = lbound(InData%BldNd_OutParam) + UB(1:1) = ubound(InData%BldNd_OutParam) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(RF, InData%B_P_2_B_L(i1)) + call NWTC_Library_PackOutParmType(RF, InData%BldNd_OutParam(i1)) end do end if - call MeshPack(RF, InData%TwrBuoyLoadPoint) - call MeshPack(RF, InData%TwrBuoyLoad) - call NWTC_Library_PackMeshMapType(RF, InData%T_P_2_T_L) - call RegPack(RF, InData%FirstWarn_TowerStrike) - call RegPack(RF, InData%AvgDiskVel) - call RegPack(RF, InData%AvgDiskVelDist) - call RegPack(RF, InData%TFinAlpha) - call RegPack(RF, InData%TFinRe) - call RegPack(RF, InData%TFinVrel) - call RegPack(RF, InData%TFinVund_i) - call RegPack(RF, InData%TFinVind_i) - call RegPack(RF, InData%TFinVrel_i) - call RegPack(RF, InData%TFinSTV_i) - call RegPack(RF, InData%TFinF_i) - call RegPack(RF, InData%TFinM_i) + call RegPackAlloc(RF, InData%BldNd_BlOutNd) + call RegPack(RF, InData%BldNd_BladesOut) + call RegPack(RF, InData%BldNd_NumNodesOut) + call RegPack(RF, InData%TFinAero) + call AD_PackTFinParameterType(RF, InData%TFin) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackRotMiscVarType(RF, OutData) +subroutine AD_UnPackRotParameterType(RF, OutData) type(RegFile), intent(inout) :: RF - type(RotMiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackRotMiscVarType' - integer(B4Ki) :: i1, i2, i3, i4 - integer(B4Ki) :: LB(4), UB(4) + type(RotParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotParameterType' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return - call BEMT_UnpackMisc(RF, OutData%BEMT) ! BEMT - call BEMT_UnpackOutput(RF, OutData%BEMT_y) ! BEMT_y - LB(1:1) = lbound(OutData%BEMT_u) - UB(1:1) = ubound(OutData%BEMT_u) - do i1 = LB(1), UB(1) - call BEMT_UnpackInput(RF, OutData%BEMT_u(i1)) ! BEMT_u - end do - call AA_UnpackMisc(RF, OutData%AA) ! AA - call AA_UnpackOutput(RF, OutData%AA_y) ! AA_y - call AA_UnpackInput(RF, OutData%AA_u) ! AA_u - call RegUnpackAlloc(RF, OutData%DisturbedInflow); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%SectAvgInflow); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%orientationAnnulus); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%R_li); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%W_Twr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%X_Twr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Y_Twr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Cant); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Toe); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TwrClrnc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%X); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Y); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Z); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%M); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Mx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%My); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Mz); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Vind_i); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%V_DiskAvg); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%yaw); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%tilt); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%hub_theta_x_root); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%V_dot_x); if (RegCheckErr(RF, RoutineName)) return - call MeshUnpack(RF, OutData%HubLoad) ! HubLoad - if (allocated(OutData%B_L_2_H_P)) deallocate(OutData%B_L_2_H_P) + if (associated(OutData%Vars)) deallocate(OutData%Vars) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%B_L_2_H_P(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_H_P.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end if - do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(RF, OutData%B_L_2_H_P(i1)) ! B_L_2_H_P - end do + else + OutData%Vars => null() end if - call RegUnpackAlloc(RF, OutData%SigmaCavitCrit); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%SigmaCavit); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%CavitWarnSet); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TwrFB); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TwrMB); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%HubFB); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%HubMB); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%NacFB); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%NacMB); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%NacDragF); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%NacDragM); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%NacFi); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%NacMi); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%BladeRootLoad)) deallocate(OutData%BladeRootLoad) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BladeRootLoad(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootLoad.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%BladeRootLoad(i1)) ! BladeRootLoad - end do - end if - if (allocated(OutData%B_L_2_R_P)) deallocate(OutData%B_L_2_R_P) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%B_L_2_R_P(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_R_P.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(RF, OutData%B_L_2_R_P(i1)) ! B_L_2_R_P - end do - end if - if (allocated(OutData%BladeBuoyLoadPoint)) deallocate(OutData%BladeBuoyLoadPoint) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BladeBuoyLoadPoint(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoadPoint.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%BladeBuoyLoadPoint(i1)) ! BladeBuoyLoadPoint - end do - end if - if (allocated(OutData%BladeBuoyLoad)) deallocate(OutData%BladeBuoyLoad) + call RegUnpack(RF, OutData%NumBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBlNds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTwrNds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrDiam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrTI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlTwist); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrCb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrCp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrCa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlCenBn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlCenBt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VolHub); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubCenBx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VolNac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacCenB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacArea); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacDragAC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VolBl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VolTwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlDL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlTaper); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlAxCent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlIN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlIT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlAN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlAT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlAM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrDL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrTaper); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrAxCent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrIT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrAT); if (RegCheckErr(RF, RoutineName)) return + call BEMT_UnpackParam(RF, OutData%BEMT) ! BEMT + call AA_UnpackParam(RF, OutData%AA) ! AA + call RegUnpack(RF, OutData%NumExtendedInputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBl_Lin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrPotent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrShadow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DBEMT_Mod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CavitCheck); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacelleDrag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompAA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpdSound); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Patm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Pvap); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AeroProjMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BEM_Mod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BladeBuoyLoad(LB(1):UB(1)),stat=stat) + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoad.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%BladeBuoyLoad(i1)) ! BladeBuoyLoad + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam end do end if - if (allocated(OutData%B_P_2_B_L)) deallocate(OutData%B_P_2_B_L) + call RegUnpack(RF, OutData%NBlOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlOutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NTwOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwOutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_TotNumOuts); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BldNd_OutParam)) deallocate(OutData%BldNd_OutParam) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%B_P_2_B_L(LB(1):UB(1)),stat=stat) + allocate(OutData%BldNd_OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_P_2_B_L.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(RF, OutData%B_P_2_B_L(i1)) ! B_P_2_B_L + call NWTC_Library_UnpackOutParmType(RF, OutData%BldNd_OutParam(i1)) ! BldNd_OutParam end do end if - call MeshUnpack(RF, OutData%TwrBuoyLoadPoint) ! TwrBuoyLoadPoint - call MeshUnpack(RF, OutData%TwrBuoyLoad) ! TwrBuoyLoad - call NWTC_Library_UnpackMeshMapType(RF, OutData%T_P_2_T_L) ! T_P_2_T_L - call RegUnpack(RF, OutData%FirstWarn_TowerStrike); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AvgDiskVel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AvgDiskVelDist); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinAlpha); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinRe); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinVrel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinVund_i); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinVind_i); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinVrel_i); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinSTV_i); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinF_i); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinM_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldNd_BlOutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_BladesOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_NumNodesOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinAero); if (RegCheckErr(RF, RoutineName)) return + call AD_UnpackTFinParameterType(RF, OutData%TFin) ! TFin end subroutine -subroutine AD_CopyElemInflowType(SrcElemInflowTypeData, DstElemInflowTypeData, CtrlCode, ErrStat, ErrMsg) - type(ElemInflowType), intent(in) :: SrcElemInflowTypeData - type(ElemInflowType), intent(inout) :: DstElemInflowTypeData +subroutine AD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(AD_ParameterType), intent(in) :: SrcParamData + type(AD_ParameterType), intent(inout) :: DstParamData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'AD_CopyElemInflowType' + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyParam' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcElemInflowTypeData%InflowVel)) then - LB(1:2) = lbound(SrcElemInflowTypeData%InflowVel) - UB(1:2) = ubound(SrcElemInflowTypeData%InflowVel) - if (.not. allocated(DstElemInflowTypeData%InflowVel)) then - allocate(DstElemInflowTypeData%InflowVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%rotors)) then + LB(1:1) = lbound(SrcParamData%rotors) + UB(1:1) = ubound(SrcParamData%rotors) + if (.not. allocated(DstParamData%rotors)) then + allocate(DstParamData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstElemInflowTypeData%InflowVel.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotors.', ErrStat, ErrMsg, RoutineName) return end if end if - DstElemInflowTypeData%InflowVel = SrcElemInflowTypeData%InflowVel + do i1 = LB(1), UB(1) + call AD_CopyRotParameterType(SrcParamData%rotors(i1), DstParamData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcElemInflowTypeData%InflowAcc)) then - LB(1:2) = lbound(SrcElemInflowTypeData%InflowAcc) - UB(1:2) = ubound(SrcElemInflowTypeData%InflowAcc) - if (.not. allocated(DstElemInflowTypeData%InflowAcc)) then - allocate(DstElemInflowTypeData%InflowAcc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + DstParamData%DT = SrcParamData%DT + DstParamData%RootName = SrcParamData%RootName + if (allocated(SrcParamData%AFI)) then + LB(1:1) = lbound(SrcParamData%AFI) + UB(1:1) = ubound(SrcParamData%AFI) + if (.not. allocated(DstParamData%AFI)) then + allocate(DstParamData%AFI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstElemInflowTypeData%InflowAcc.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFI.', ErrStat, ErrMsg, RoutineName) return end if end if - DstElemInflowTypeData%InflowAcc = SrcElemInflowTypeData%InflowAcc + do i1 = LB(1), UB(1) + call AFI_CopyParam(SrcParamData%AFI(i1), DstParamData%AFI(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if + DstParamData%Skew_Mod = SrcParamData%Skew_Mod + DstParamData%Wake_Mod = SrcParamData%Wake_Mod + call FVW_CopyParam(SrcParamData%FVW, DstParamData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%CompAeroMaps = SrcParamData%CompAeroMaps + DstParamData%UA_Flag = SrcParamData%UA_Flag + DstParamData%CompSeaSt = SrcParamData%CompSeaSt + DstParamData%FlowField => SrcParamData%FlowField + DstParamData%SectAvg = SrcParamData%SectAvg + DstParamData%SA_Weighting = SrcParamData%SA_Weighting + DstParamData%SA_PsiBwd = SrcParamData%SA_PsiBwd + DstParamData%SA_PsiFwd = SrcParamData%SA_PsiFwd + DstParamData%SA_nPerSec = SrcParamData%SA_nPerSec + DstParamData%WaveField => SrcParamData%WaveField end subroutine -subroutine AD_DestroyElemInflowType(ElemInflowTypeData, ErrStat, ErrMsg) - type(ElemInflowType), intent(inout) :: ElemInflowTypeData +subroutine AD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(AD_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'AD_DestroyElemInflowType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyParam' ErrStat = ErrID_None ErrMsg = '' - if (allocated(ElemInflowTypeData%InflowVel)) then - deallocate(ElemInflowTypeData%InflowVel) + if (allocated(ParamData%rotors)) then + LB(1:1) = lbound(ParamData%rotors) + UB(1:1) = ubound(ParamData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotParameterType(ParamData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%rotors) end if - if (allocated(ElemInflowTypeData%InflowAcc)) then - deallocate(ElemInflowTypeData%InflowAcc) + if (allocated(ParamData%AFI)) then + LB(1:1) = lbound(ParamData%AFI) + UB(1:1) = ubound(ParamData%AFI) + do i1 = LB(1), UB(1) + call AFI_DestroyParam(ParamData%AFI(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%AFI) end if + call FVW_DestroyParam(ParamData%FVW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(ParamData%FlowField) + nullify(ParamData%WaveField) end subroutine -subroutine AD_PackElemInflowType(RF, Indata) +subroutine AD_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF - type(ElemInflowType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackElemInflowType' + type(AD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackParam' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%InflowVel) - call RegPackAlloc(RF, InData%InflowAcc) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AD_UnPackElemInflowType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(ElemInflowType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackElemInflowType' - integer(B4Ki) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%InflowVel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InflowAcc); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AD_CopyRotInflowType(SrcRotInflowTypeData, DstRotInflowTypeData, CtrlCode, ErrStat, ErrMsg) - type(RotInflowType), intent(in) :: SrcRotInflowTypeData - type(RotInflowType), intent(inout) :: DstRotInflowTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyRotInflowType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcRotInflowTypeData%Blade)) then - LB(1:1) = lbound(SrcRotInflowTypeData%Blade) - UB(1:1) = ubound(SrcRotInflowTypeData%Blade) - if (.not. allocated(DstRotInflowTypeData%Blade)) then - allocate(DstRotInflowTypeData%Blade(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInflowTypeData%Blade.', ErrStat, ErrMsg, RoutineName) - return - end if - end if + call RegPack(RF, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) do i1 = LB(1), UB(1) - call AD_CopyElemInflowType(SrcRotInflowTypeData%Blade(i1), DstRotInflowTypeData%Blade(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + call AD_PackRotParameterType(RF, InData%rotors(i1)) end do end if - call AD_CopyElemInflowType(SrcRotInflowTypeData%Tower, DstRotInflowTypeData%Tower, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - DstRotInflowTypeData%InflowOnHub = SrcRotInflowTypeData%InflowOnHub - DstRotInflowTypeData%InflowOnNacelle = SrcRotInflowTypeData%InflowOnNacelle - DstRotInflowTypeData%InflowOnTailFin = SrcRotInflowTypeData%InflowOnTailFin - DstRotInflowTypeData%AvgDiskVel = SrcRotInflowTypeData%AvgDiskVel -end subroutine - -subroutine AD_DestroyRotInflowType(RotInflowTypeData, ErrStat, ErrMsg) - type(RotInflowType), intent(inout) :: RotInflowTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_DestroyRotInflowType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(RotInflowTypeData%Blade)) then - LB(1:1) = lbound(RotInflowTypeData%Blade) - UB(1:1) = ubound(RotInflowTypeData%Blade) + call RegPack(RF, InData%DT) + call RegPack(RF, InData%RootName) + call RegPack(RF, allocated(InData%AFI)) + if (allocated(InData%AFI)) then + call RegPackBounds(RF, 1, lbound(InData%AFI), ubound(InData%AFI)) + LB(1:1) = lbound(InData%AFI) + UB(1:1) = ubound(InData%AFI) do i1 = LB(1), UB(1) - call AD_DestroyElemInflowType(RotInflowTypeData%Blade(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AFI_PackParam(RF, InData%AFI(i1)) end do - deallocate(RotInflowTypeData%Blade) end if - call AD_DestroyElemInflowType(RotInflowTypeData%Tower, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -end subroutine - -subroutine AD_PackRotInflowType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(RotInflowType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackRotInflowType' - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%Blade)) - if (allocated(InData%Blade)) then - call RegPackBounds(RF, 1, lbound(InData%Blade), ubound(InData%Blade)) - LB(1:1) = lbound(InData%Blade) - UB(1:1) = ubound(InData%Blade) - do i1 = LB(1), UB(1) - call AD_PackElemInflowType(RF, InData%Blade(i1)) - end do + call RegPack(RF, InData%Skew_Mod) + call RegPack(RF, InData%Wake_Mod) + call FVW_PackParam(RF, InData%FVW) + call RegPack(RF, InData%CompAeroMaps) + call RegPack(RF, InData%UA_Flag) + call RegPack(RF, InData%CompSeaSt) + call RegPack(RF, associated(InData%FlowField)) + if (associated(InData%FlowField)) then + call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) + end if + end if + call RegPack(RF, InData%SectAvg) + call RegPack(RF, InData%SA_Weighting) + call RegPack(RF, InData%SA_PsiBwd) + call RegPack(RF, InData%SA_PsiFwd) + call RegPack(RF, InData%SA_nPerSec) + call RegPack(RF, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) + end if end if - call AD_PackElemInflowType(RF, InData%Tower) - call RegPack(RF, InData%InflowOnHub) - call RegPack(RF, InData%InflowOnNacelle) - call RegPack(RF, InData%InflowOnTailFin) - call RegPack(RF, InData%AvgDiskVel) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackRotInflowType(RF, OutData) +subroutine AD_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF - type(RotInflowType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackRotInflowType' - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) + type(AD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackParam' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%Blade)) deallocate(OutData%Blade) + if (allocated(OutData%rotors)) deallocate(OutData%rotors) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Blade(LB(1):UB(1)),stat=stat) + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Blade.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackElemInflowType(RF, OutData%Blade(i1)) ! Blade + call AD_UnpackRotParameterType(RF, OutData%rotors(i1)) ! rotors end do end if - call AD_UnpackElemInflowType(RF, OutData%Tower) ! Tower - call RegUnpack(RF, OutData%InflowOnHub); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%InflowOnNacelle); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%InflowOnTailFin); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AvgDiskVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%AFI)) deallocate(OutData%AFI) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%AFI(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFI.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AFI_UnpackParam(RF, OutData%AFI(i1)) ! AFI + end do + end if + call RegUnpack(RF, OutData%Skew_Mod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Wake_Mod); if (RegCheckErr(RF, RoutineName)) return + call FVW_UnpackParam(RF, OutData%FVW) ! FVW + call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UA_Flag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompSeaSt); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%FlowField)) deallocate(OutData%FlowField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%FlowField) + else + allocate(OutData%FlowField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField + end if + else + OutData%FlowField => null() + end if + call RegUnpack(RF, OutData%SectAvg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SA_Weighting); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SA_PsiBwd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SA_PsiFwd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SA_nPerSec); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(RF, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if end subroutine -subroutine AD_CopyInflowType(SrcInflowTypeData, DstInflowTypeData, CtrlCode, ErrStat, ErrMsg) - type(AD_InflowType), intent(in) :: SrcInflowTypeData - type(AD_InflowType), intent(inout) :: DstInflowTypeData +subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotInputType), intent(inout) :: SrcRotInputTypeData + type(RotInputType), intent(inout) :: DstRotInputTypeData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg @@ -4298,1806 +4631,1860 @@ subroutine AD_CopyInflowType(SrcInflowTypeData, DstInflowTypeData, CtrlCode, Err integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyInflowType' + character(*), parameter :: RoutineName = 'AD_CopyRotInputType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcInflowTypeData%InflowWakeVel)) then - LB(1:2) = lbound(SrcInflowTypeData%InflowWakeVel) - UB(1:2) = ubound(SrcInflowTypeData%InflowWakeVel) - if (.not. allocated(DstInflowTypeData%InflowWakeVel)) then - allocate(DstInflowTypeData%InflowWakeVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + call MeshCopy(SrcRotInputTypeData%NacelleMotion, DstRotInputTypeData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotInputTypeData%TowerMotion, DstRotInputTypeData%TowerMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotInputTypeData%HubMotion, DstRotInputTypeData%HubMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotInputTypeData%BladeRootMotion)) then + LB(1:1) = lbound(SrcRotInputTypeData%BladeRootMotion) + UB(1:1) = ubound(SrcRotInputTypeData%BladeRootMotion) + if (.not. allocated(DstRotInputTypeData%BladeRootMotion)) then + allocate(DstRotInputTypeData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowTypeData%InflowWakeVel.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeRootMotion.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInflowTypeData%InflowWakeVel = SrcInflowTypeData%InflowWakeVel + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotInputTypeData%BladeRootMotion(i1), DstRotInputTypeData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcInflowTypeData%RotInflow)) then - LB(1:1) = lbound(SrcInflowTypeData%RotInflow) - UB(1:1) = ubound(SrcInflowTypeData%RotInflow) - if (.not. allocated(DstInflowTypeData%RotInflow)) then - allocate(DstInflowTypeData%RotInflow(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotInputTypeData%BladeMotion)) then + LB(1:1) = lbound(SrcRotInputTypeData%BladeMotion) + UB(1:1) = ubound(SrcRotInputTypeData%BladeMotion) + if (.not. allocated(DstRotInputTypeData%BladeMotion)) then + allocate(DstRotInputTypeData%BladeMotion(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowTypeData%RotInflow.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeMotion.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call AD_CopyRotInflowType(SrcInflowTypeData%RotInflow(i1), DstInflowTypeData%RotInflow(i1), CtrlCode, ErrStat2, ErrMsg2) + call MeshCopy(SrcRotInputTypeData%BladeMotion(i1), DstRotInputTypeData%BladeMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if + call MeshCopy(SrcRotInputTypeData%TFinMotion, DstRotInputTypeData%TFinMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotInputTypeData%UserProp)) then + LB(1:2) = lbound(SrcRotInputTypeData%UserProp) + UB(1:2) = ubound(SrcRotInputTypeData%UserProp) + if (.not. allocated(DstRotInputTypeData%UserProp)) then + allocate(DstRotInputTypeData%UserProp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%UserProp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputTypeData%UserProp = SrcRotInputTypeData%UserProp + end if end subroutine -subroutine AD_DestroyInflowType(InflowTypeData, ErrStat, ErrMsg) - type(AD_InflowType), intent(inout) :: InflowTypeData - integer(IntKi), intent( out) :: ErrStat +subroutine AD_DestroyRotInputType(RotInputTypeData, ErrStat, ErrMsg) + type(RotInputType), intent(inout) :: RotInputTypeData + integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg integer(B4Ki) :: i1, i2 integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_DestroyInflowType' + character(*), parameter :: RoutineName = 'AD_DestroyRotInputType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(InflowTypeData%InflowWakeVel)) then - deallocate(InflowTypeData%InflowWakeVel) + call MeshDestroy( RotInputTypeData%NacelleMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotInputTypeData%TowerMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotInputTypeData%HubMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotInputTypeData%BladeRootMotion)) then + LB(1:1) = lbound(RotInputTypeData%BladeRootMotion) + UB(1:1) = ubound(RotInputTypeData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshDestroy( RotInputTypeData%BladeRootMotion(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotInputTypeData%BladeRootMotion) end if - if (allocated(InflowTypeData%RotInflow)) then - LB(1:1) = lbound(InflowTypeData%RotInflow) - UB(1:1) = ubound(InflowTypeData%RotInflow) + if (allocated(RotInputTypeData%BladeMotion)) then + LB(1:1) = lbound(RotInputTypeData%BladeMotion) + UB(1:1) = ubound(RotInputTypeData%BladeMotion) do i1 = LB(1), UB(1) - call AD_DestroyRotInflowType(InflowTypeData%RotInflow(i1), ErrStat2, ErrMsg2) + call MeshDestroy( RotInputTypeData%BladeMotion(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(InflowTypeData%RotInflow) + deallocate(RotInputTypeData%BladeMotion) + end if + call MeshDestroy( RotInputTypeData%TFinMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotInputTypeData%UserProp)) then + deallocate(RotInputTypeData%UserProp) end if end subroutine -subroutine AD_PackInflowType(RF, Indata) +subroutine AD_PackRotInputType(RF, Indata) type(RegFile), intent(inout) :: RF - type(AD_InflowType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackInflowType' + type(RotInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotInputType' integer(B4Ki) :: i1, i2 integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%InflowWakeVel) - call RegPack(RF, allocated(InData%RotInflow)) - if (allocated(InData%RotInflow)) then - call RegPackBounds(RF, 1, lbound(InData%RotInflow), ubound(InData%RotInflow)) - LB(1:1) = lbound(InData%RotInflow) - UB(1:1) = ubound(InData%RotInflow) + call MeshPack(RF, InData%NacelleMotion) + call MeshPack(RF, InData%TowerMotion) + call MeshPack(RF, InData%HubMotion) + call RegPack(RF, allocated(InData%BladeRootMotion)) + if (allocated(InData%BladeRootMotion)) then + call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) + LB(1:1) = lbound(InData%BladeRootMotion) + UB(1:1) = ubound(InData%BladeRootMotion) do i1 = LB(1), UB(1) - call AD_PackRotInflowType(RF, InData%RotInflow(i1)) + call MeshPack(RF, InData%BladeRootMotion(i1)) + end do + end if + call RegPack(RF, allocated(InData%BladeMotion)) + if (allocated(InData%BladeMotion)) then + call RegPackBounds(RF, 1, lbound(InData%BladeMotion), ubound(InData%BladeMotion)) + LB(1:1) = lbound(InData%BladeMotion) + UB(1:1) = ubound(InData%BladeMotion) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeMotion(i1)) end do end if + call MeshPack(RF, InData%TFinMotion) + call RegPackAlloc(RF, InData%UserProp) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackInflowType(RF, OutData) +subroutine AD_UnPackRotInputType(RF, OutData) type(RegFile), intent(inout) :: RF - type(AD_InflowType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackInflowType' + type(RotInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotInputType' integer(B4Ki) :: i1, i2 integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%InflowWakeVel); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%RotInflow)) deallocate(OutData%RotInflow) + call MeshUnpack(RF, OutData%NacelleMotion) ! NacelleMotion + call MeshUnpack(RF, OutData%TowerMotion) ! TowerMotion + call MeshUnpack(RF, OutData%HubMotion) ! HubMotion + if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%RotInflow(LB(1):UB(1)),stat=stat) + allocate(OutData%BladeRootMotion(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotInflow.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackRotInflowType(RF, OutData%RotInflow(i1)) ! RotInflow + call MeshUnpack(RF, OutData%BladeRootMotion(i1)) ! BladeRootMotion + end do + end if + if (allocated(OutData%BladeMotion)) deallocate(OutData%BladeMotion) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeMotion(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladeMotion(i1)) ! BladeMotion end do end if + call MeshUnpack(RF, OutData%TFinMotion) ! TFinMotion + call RegUnpackAlloc(RF, OutData%UserProp); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(AD_MiscVarType), intent(inout) :: SrcMiscData - type(AD_MiscVarType), intent(inout) :: DstMiscData +subroutine AD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(AD_InputType), intent(inout) :: SrcInputData + type(AD_InputType), intent(inout) :: DstInputData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyMisc' + character(*), parameter :: RoutineName = 'AD_CopyInput' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcMiscData%rotors)) then - LB(1:1) = lbound(SrcMiscData%rotors) - UB(1:1) = ubound(SrcMiscData%rotors) - if (.not. allocated(DstMiscData%rotors)) then - allocate(DstMiscData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInputData%rotors)) then + LB(1:1) = lbound(SrcInputData%rotors) + UB(1:1) = ubound(SrcInputData%rotors) + if (.not. allocated(DstInputData%rotors)) then + allocate(DstInputData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rotors.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%rotors.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call AD_CopyRotMiscVarType(SrcMiscData%rotors(i1), DstMiscData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call AD_CopyRotInputType(SrcInputData%rotors(i1), DstInputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcMiscData%FVW_u)) then - LB(1:1) = lbound(SrcMiscData%FVW_u) - UB(1:1) = ubound(SrcMiscData%FVW_u) - if (.not. allocated(DstMiscData%FVW_u)) then - allocate(DstMiscData%FVW_u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FVW_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if +end subroutine + +subroutine AD_DestroyInput(InputData, ErrStat, ErrMsg) + type(AD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%rotors)) then + LB(1:1) = lbound(InputData%rotors) + UB(1:1) = ubound(InputData%rotors) do i1 = LB(1), UB(1) - call FVW_CopyInput(SrcMiscData%FVW_u(i1), DstMiscData%FVW_u(i1), CtrlCode, ErrStat2, ErrMsg2) + call AD_DestroyRotInputType(InputData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end do + deallocate(InputData%rotors) end if - call FVW_CopyOutput(SrcMiscData%FVW_y, DstMiscData%FVW_y, CtrlCode, ErrStat2, ErrMsg2) +end subroutine + +subroutine AD_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackInput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotInputType(RF, InData%rotors(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackInput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotInputType(RF, OutData%rotors(i1)) ! rotors + end do + end if +end subroutine + +subroutine AD_CopyRotOutputType(SrcRotOutputTypeData, DstRotOutputTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotOutputType), intent(inout) :: SrcRotOutputTypeData + type(RotOutputType), intent(inout) :: DstRotOutputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotOutputType' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcRotOutputTypeData%NacelleLoad, DstRotOutputTypeData%NacelleLoad, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call FVW_CopyMisc(SrcMiscData%FVW, DstMiscData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call MeshCopy(SrcRotOutputTypeData%HubLoad, DstRotOutputTypeData%HubLoad, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - if (allocated(SrcMiscData%WindPos)) then - LB(1:2) = lbound(SrcMiscData%WindPos) - UB(1:2) = ubound(SrcMiscData%WindPos) - if (.not. allocated(DstMiscData%WindPos)) then - allocate(DstMiscData%WindPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + call MeshCopy(SrcRotOutputTypeData%TowerLoad, DstRotOutputTypeData%TowerLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotOutputTypeData%BladeLoad)) then + LB(1:1) = lbound(SrcRotOutputTypeData%BladeLoad) + UB(1:1) = ubound(SrcRotOutputTypeData%BladeLoad) + if (.not. allocated(DstRotOutputTypeData%BladeLoad)) then + allocate(DstRotOutputTypeData%BladeLoad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindPos.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotOutputTypeData%BladeLoad.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%WindPos = SrcMiscData%WindPos + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotOutputTypeData%BladeLoad(i1), DstRotOutputTypeData%BladeLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcMiscData%WindVel)) then - LB(1:2) = lbound(SrcMiscData%WindVel) - UB(1:2) = ubound(SrcMiscData%WindVel) - if (.not. allocated(DstMiscData%WindVel)) then - allocate(DstMiscData%WindVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + call MeshCopy(SrcRotOutputTypeData%TFinLoad, DstRotOutputTypeData%TFinLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotOutputTypeData%WriteOutput)) then + LB(1:1) = lbound(SrcRotOutputTypeData%WriteOutput) + UB(1:1) = ubound(SrcRotOutputTypeData%WriteOutput) + if (.not. allocated(DstRotOutputTypeData%WriteOutput)) then + allocate(DstRotOutputTypeData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindVel.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotOutputTypeData%WriteOutput.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%WindVel = SrcMiscData%WindVel - end if - if (allocated(SrcMiscData%WindAcc)) then - LB(1:2) = lbound(SrcMiscData%WindAcc) - UB(1:2) = ubound(SrcMiscData%WindAcc) - if (.not. allocated(DstMiscData%WindAcc)) then - allocate(DstMiscData%WindAcc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindAcc.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%WindAcc = SrcMiscData%WindAcc - end if - if (allocated(SrcMiscData%Inflow)) then - LB(1:1) = lbound(SrcMiscData%Inflow) - UB(1:1) = ubound(SrcMiscData%Inflow) - if (.not. allocated(DstMiscData%Inflow)) then - allocate(DstMiscData%Inflow(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Inflow.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call AD_CopyInflowType(SrcMiscData%Inflow(i1), DstMiscData%Inflow(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstRotOutputTypeData%WriteOutput = SrcRotOutputTypeData%WriteOutput end if end subroutine -subroutine AD_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(AD_MiscVarType), intent(inout) :: MiscData +subroutine AD_DestroyRotOutputType(RotOutputTypeData, ErrStat, ErrMsg) + type(RotOutputType), intent(inout) :: RotOutputTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_DestroyMisc' + character(*), parameter :: RoutineName = 'AD_DestroyRotOutputType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(MiscData%rotors)) then - LB(1:1) = lbound(MiscData%rotors) - UB(1:1) = ubound(MiscData%rotors) - do i1 = LB(1), UB(1) - call AD_DestroyRotMiscVarType(MiscData%rotors(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%rotors) - end if - if (allocated(MiscData%FVW_u)) then - LB(1:1) = lbound(MiscData%FVW_u) - UB(1:1) = ubound(MiscData%FVW_u) - do i1 = LB(1), UB(1) - call FVW_DestroyInput(MiscData%FVW_u(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%FVW_u) - end if - call FVW_DestroyOutput(MiscData%FVW_y, ErrStat2, ErrMsg2) + call MeshDestroy( RotOutputTypeData%NacelleLoad, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call FVW_DestroyMisc(MiscData%FVW, ErrStat2, ErrMsg2) + call MeshDestroy( RotOutputTypeData%HubLoad, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(MiscData%WindPos)) then - deallocate(MiscData%WindPos) - end if - if (allocated(MiscData%WindVel)) then - deallocate(MiscData%WindVel) - end if - if (allocated(MiscData%WindAcc)) then - deallocate(MiscData%WindAcc) - end if - if (allocated(MiscData%Inflow)) then - LB(1:1) = lbound(MiscData%Inflow) - UB(1:1) = ubound(MiscData%Inflow) + call MeshDestroy( RotOutputTypeData%TowerLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotOutputTypeData%BladeLoad)) then + LB(1:1) = lbound(RotOutputTypeData%BladeLoad) + UB(1:1) = ubound(RotOutputTypeData%BladeLoad) do i1 = LB(1), UB(1) - call AD_DestroyInflowType(MiscData%Inflow(i1), ErrStat2, ErrMsg2) + call MeshDestroy( RotOutputTypeData%BladeLoad(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%Inflow) + deallocate(RotOutputTypeData%BladeLoad) + end if + call MeshDestroy( RotOutputTypeData%TFinLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotOutputTypeData%WriteOutput)) then + deallocate(RotOutputTypeData%WriteOutput) end if end subroutine -subroutine AD_PackMisc(RF, Indata) +subroutine AD_PackRotOutputType(RF, Indata) type(RegFile), intent(inout) :: RF - type(AD_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackMisc' - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) + type(RotOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotOutputType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%rotors)) - if (allocated(InData%rotors)) then - call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) - LB(1:1) = lbound(InData%rotors) - UB(1:1) = ubound(InData%rotors) - do i1 = LB(1), UB(1) - call AD_PackRotMiscVarType(RF, InData%rotors(i1)) - end do - end if - call RegPack(RF, allocated(InData%FVW_u)) - if (allocated(InData%FVW_u)) then - call RegPackBounds(RF, 1, lbound(InData%FVW_u), ubound(InData%FVW_u)) - LB(1:1) = lbound(InData%FVW_u) - UB(1:1) = ubound(InData%FVW_u) - do i1 = LB(1), UB(1) - call FVW_PackInput(RF, InData%FVW_u(i1)) - end do - end if - call FVW_PackOutput(RF, InData%FVW_y) - call FVW_PackMisc(RF, InData%FVW) - call RegPackAlloc(RF, InData%WindPos) - call RegPackAlloc(RF, InData%WindVel) - call RegPackAlloc(RF, InData%WindAcc) - call RegPack(RF, allocated(InData%Inflow)) - if (allocated(InData%Inflow)) then - call RegPackBounds(RF, 1, lbound(InData%Inflow), ubound(InData%Inflow)) - LB(1:1) = lbound(InData%Inflow) - UB(1:1) = ubound(InData%Inflow) + call MeshPack(RF, InData%NacelleLoad) + call MeshPack(RF, InData%HubLoad) + call MeshPack(RF, InData%TowerLoad) + call RegPack(RF, allocated(InData%BladeLoad)) + if (allocated(InData%BladeLoad)) then + call RegPackBounds(RF, 1, lbound(InData%BladeLoad), ubound(InData%BladeLoad)) + LB(1:1) = lbound(InData%BladeLoad) + UB(1:1) = ubound(InData%BladeLoad) do i1 = LB(1), UB(1) - call AD_PackInflowType(RF, InData%Inflow(i1)) + call MeshPack(RF, InData%BladeLoad(i1)) end do end if + call MeshPack(RF, InData%TFinLoad) + call RegPackAlloc(RF, InData%WriteOutput) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackMisc(RF, OutData) +subroutine AD_UnPackRotOutputType(RF, OutData) type(RegFile), intent(inout) :: RF - type(AD_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackMisc' - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) + type(RotOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotOutputType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%rotors)) deallocate(OutData%rotors) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%rotors(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call AD_UnpackRotMiscVarType(RF, OutData%rotors(i1)) ! rotors - end do - end if - if (allocated(OutData%FVW_u)) deallocate(OutData%FVW_u) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%FVW_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FVW_u.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call FVW_UnpackInput(RF, OutData%FVW_u(i1)) ! FVW_u - end do - end if - call FVW_UnpackOutput(RF, OutData%FVW_y) ! FVW_y - call FVW_UnpackMisc(RF, OutData%FVW) ! FVW - call RegUnpackAlloc(RF, OutData%WindPos); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%WindVel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%WindAcc); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%Inflow)) deallocate(OutData%Inflow) + call MeshUnpack(RF, OutData%NacelleLoad) ! NacelleLoad + call MeshUnpack(RF, OutData%HubLoad) ! HubLoad + call MeshUnpack(RF, OutData%TowerLoad) ! TowerLoad + if (allocated(OutData%BladeLoad)) deallocate(OutData%BladeLoad) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Inflow(LB(1):UB(1)),stat=stat) + allocate(OutData%BladeLoad(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Inflow.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLoad.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackInflowType(RF, OutData%Inflow(i1)) ! Inflow + call MeshUnpack(RF, OutData%BladeLoad(i1)) ! BladeLoad end do end if + call MeshUnpack(RF, OutData%TFinLoad) ! TFinLoad + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_CopyJac_u_idxStarts(SrcJac_u_idxStartsData, DstJac_u_idxStartsData, CtrlCode, ErrStat, ErrMsg) - type(Jac_u_idxStarts), intent(in) :: SrcJac_u_idxStartsData - type(Jac_u_idxStarts), intent(inout) :: DstJac_u_idxStartsData +subroutine AD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(AD_OutputType), intent(inout) :: SrcOutputData + type(AD_OutputType), intent(inout) :: DstOutputData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'AD_CopyJac_u_idxStarts' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyOutput' ErrStat = ErrID_None ErrMsg = '' - DstJac_u_idxStartsData%Nacelle = SrcJac_u_idxStartsData%Nacelle - DstJac_u_idxStartsData%Hub = SrcJac_u_idxStartsData%Hub - DstJac_u_idxStartsData%TFin = SrcJac_u_idxStartsData%TFin - DstJac_u_idxStartsData%Tower = SrcJac_u_idxStartsData%Tower - DstJac_u_idxStartsData%BladeRoot = SrcJac_u_idxStartsData%BladeRoot - DstJac_u_idxStartsData%Blade = SrcJac_u_idxStartsData%Blade - DstJac_u_idxStartsData%UserProp = SrcJac_u_idxStartsData%UserProp - DstJac_u_idxStartsData%Extended = SrcJac_u_idxStartsData%Extended -end subroutine - -subroutine AD_DestroyJac_u_idxStarts(Jac_u_idxStartsData, ErrStat, ErrMsg) - type(Jac_u_idxStarts), intent(inout) :: Jac_u_idxStartsData + if (allocated(SrcOutputData%rotors)) then + LB(1:1) = lbound(SrcOutputData%rotors) + UB(1:1) = ubound(SrcOutputData%rotors) + if (.not. allocated(DstOutputData%rotors)) then + allocate(DstOutputData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotOutputType(SrcOutputData%rotors(i1), DstOutputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine AD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(AD_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'AD_DestroyJac_u_idxStarts' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' + if (allocated(OutputData%rotors)) then + LB(1:1) = lbound(OutputData%rotors) + UB(1:1) = ubound(OutputData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotOutputType(OutputData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%rotors) + end if end subroutine -subroutine AD_PackJac_u_idxStarts(RF, Indata) +subroutine AD_PackOutput(RF, Indata) type(RegFile), intent(inout) :: RF - type(Jac_u_idxStarts), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackJac_u_idxStarts' + type(AD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%Nacelle) - call RegPack(RF, InData%Hub) - call RegPack(RF, InData%TFin) - call RegPack(RF, InData%Tower) - call RegPack(RF, InData%BladeRoot) - call RegPack(RF, InData%Blade) - call RegPack(RF, InData%UserProp) - call RegPack(RF, InData%Extended) + call RegPack(RF, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotOutputType(RF, InData%rotors(i1)) + end do + end if if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackJac_u_idxStarts(RF, OutData) +subroutine AD_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF - type(Jac_u_idxStarts), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackJac_u_idxStarts' + type(AD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%Nacelle); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Hub); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFin); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Tower); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%BladeRoot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Blade); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%UserProp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Extended); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AD_CopyJac_y_idxStarts(SrcJac_y_idxStartsData, DstJac_y_idxStartsData, CtrlCode, ErrStat, ErrMsg) - type(Jac_y_idxStarts), intent(in) :: SrcJac_y_idxStartsData - type(Jac_y_idxStarts), intent(inout) :: DstJac_y_idxStartsData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'AD_CopyJac_y_idxStarts' - ErrStat = ErrID_None - ErrMsg = '' - DstJac_y_idxStartsData%NacelleLoad = SrcJac_y_idxStartsData%NacelleLoad - DstJac_y_idxStartsData%HubLoad = SrcJac_y_idxStartsData%HubLoad - DstJac_y_idxStartsData%TFinLoad = SrcJac_y_idxStartsData%TFinLoad - DstJac_y_idxStartsData%TowerLoad = SrcJac_y_idxStartsData%TowerLoad - DstJac_y_idxStartsData%BladeLoad = SrcJac_y_idxStartsData%BladeLoad -end subroutine - -subroutine AD_DestroyJac_y_idxStarts(Jac_y_idxStartsData, ErrStat, ErrMsg) - type(Jac_y_idxStarts), intent(inout) :: Jac_y_idxStartsData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'AD_DestroyJac_y_idxStarts' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine AD_PackJac_y_idxStarts(RF, Indata) - type(RegFile), intent(inout) :: RF - type(Jac_y_idxStarts), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackJac_y_idxStarts' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%NacelleLoad) - call RegPack(RF, InData%HubLoad) - call RegPack(RF, InData%TFinLoad) - call RegPack(RF, InData%TowerLoad) - call RegPack(RF, InData%BladeLoad) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AD_UnPackJac_y_idxStarts(RF, OutData) - type(RegFile), intent(inout) :: RF - type(Jac_y_idxStarts), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackJac_y_idxStarts' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%NacelleLoad); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%HubLoad); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinLoad); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TowerLoad); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%BladeLoad); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotOutputType(RF, OutData%rotors(i1)) ! rotors + end do + end if end subroutine -subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeData, CtrlCode, ErrStat, ErrMsg) - type(RotParameterType), intent(in) :: SrcRotParameterTypeData - type(RotParameterType), intent(inout) :: DstRotParameterTypeData +subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotMiscVarType), intent(inout) :: SrcRotMiscVarTypeData + type(RotMiscVarType), intent(inout) :: DstRotMiscVarTypeData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyRotParameterType' + character(*), parameter :: RoutineName = 'AD_CopyRotMiscVarType' ErrStat = ErrID_None ErrMsg = '' - DstRotParameterTypeData%NumBlades = SrcRotParameterTypeData%NumBlades - DstRotParameterTypeData%NumBlNds = SrcRotParameterTypeData%NumBlNds - DstRotParameterTypeData%NumTwrNds = SrcRotParameterTypeData%NumTwrNds - if (allocated(SrcRotParameterTypeData%TwrDiam)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrDiam) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrDiam) - if (.not. allocated(DstRotParameterTypeData%TwrDiam)) then - allocate(DstRotParameterTypeData%TwrDiam(LB(1):UB(1)), stat=ErrStat2) + call NWTC_Library_CopyModJacType(SrcRotMiscVarTypeData%Jac, DstRotMiscVarTypeData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyRotContinuousStateType(SrcRotMiscVarTypeData%x_init, DstRotMiscVarTypeData%x_init, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyRotContinuousStateType(SrcRotMiscVarTypeData%x_perturb, DstRotMiscVarTypeData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyRotContinuousStateType(SrcRotMiscVarTypeData%dxdt_lin, DstRotMiscVarTypeData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyRotInputType(SrcRotMiscVarTypeData%u_perturb, DstRotMiscVarTypeData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyRotOutputType(SrcRotMiscVarTypeData%y_lin, DstRotMiscVarTypeData%y_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyRotConstraintStateType(SrcRotMiscVarTypeData%z_lin, DstRotMiscVarTypeData%z_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyRotOtherStateType(SrcRotMiscVarTypeData%OtherState_init, DstRotMiscVarTypeData%OtherState_init, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyRotOtherStateType(SrcRotMiscVarTypeData%OtherState_jac, DstRotMiscVarTypeData%OtherState_jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call BEMT_CopyMisc(SrcRotMiscVarTypeData%BEMT, DstRotMiscVarTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call BEMT_CopyOutput(SrcRotMiscVarTypeData%BEMT_y, DstRotMiscVarTypeData%BEMT_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + LB(1:1) = lbound(SrcRotMiscVarTypeData%BEMT_u) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BEMT_u) + do i1 = LB(1), UB(1) + call BEMT_CopyInput(SrcRotMiscVarTypeData%BEMT_u(i1), DstRotMiscVarTypeData%BEMT_u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call AA_CopyMisc(SrcRotMiscVarTypeData%AA, DstRotMiscVarTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyOutput(SrcRotMiscVarTypeData%AA_y, DstRotMiscVarTypeData%AA_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyInput(SrcRotMiscVarTypeData%AA_u, DstRotMiscVarTypeData%AA_u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotMiscVarTypeData%DisturbedInflow)) then + LB(1:3) = lbound(SrcRotMiscVarTypeData%DisturbedInflow) + UB(1:3) = ubound(SrcRotMiscVarTypeData%DisturbedInflow) + if (.not. allocated(DstRotMiscVarTypeData%DisturbedInflow)) then + allocate(DstRotMiscVarTypeData%DisturbedInflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDiam.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%DisturbedInflow.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%TwrDiam = SrcRotParameterTypeData%TwrDiam + DstRotMiscVarTypeData%DisturbedInflow = SrcRotMiscVarTypeData%DisturbedInflow end if - if (allocated(SrcRotParameterTypeData%TwrCd)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrCd) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrCd) - if (.not. allocated(DstRotParameterTypeData%TwrCd)) then - allocate(DstRotParameterTypeData%TwrCd(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%SectAvgInflow)) then + LB(1:3) = lbound(SrcRotMiscVarTypeData%SectAvgInflow) + UB(1:3) = ubound(SrcRotMiscVarTypeData%SectAvgInflow) + if (.not. allocated(DstRotMiscVarTypeData%SectAvgInflow)) then + allocate(DstRotMiscVarTypeData%SectAvgInflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCd.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%SectAvgInflow.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%TwrCd = SrcRotParameterTypeData%TwrCd + DstRotMiscVarTypeData%SectAvgInflow = SrcRotMiscVarTypeData%SectAvgInflow end if - if (allocated(SrcRotParameterTypeData%TwrTI)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrTI) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrTI) - if (.not. allocated(DstRotParameterTypeData%TwrTI)) then - allocate(DstRotParameterTypeData%TwrTI(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%orientationAnnulus)) then + LB(1:4) = lbound(SrcRotMiscVarTypeData%orientationAnnulus) + UB(1:4) = ubound(SrcRotMiscVarTypeData%orientationAnnulus) + if (.not. allocated(DstRotMiscVarTypeData%orientationAnnulus)) then + allocate(DstRotMiscVarTypeData%orientationAnnulus(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTI.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%orientationAnnulus.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%TwrTI = SrcRotParameterTypeData%TwrTI + DstRotMiscVarTypeData%orientationAnnulus = SrcRotMiscVarTypeData%orientationAnnulus end if - if (allocated(SrcRotParameterTypeData%BlTwist)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlTwist) - UB(1:2) = ubound(SrcRotParameterTypeData%BlTwist) - if (.not. allocated(DstRotParameterTypeData%BlTwist)) then - allocate(DstRotParameterTypeData%BlTwist(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%R_li)) then + LB(1:4) = lbound(SrcRotMiscVarTypeData%R_li) + UB(1:4) = ubound(SrcRotMiscVarTypeData%R_li) + if (.not. allocated(DstRotMiscVarTypeData%R_li)) then + allocate(DstRotMiscVarTypeData%R_li(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTwist.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%R_li.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%BlTwist = SrcRotParameterTypeData%BlTwist + DstRotMiscVarTypeData%R_li = SrcRotMiscVarTypeData%R_li end if - if (allocated(SrcRotParameterTypeData%TwrCb)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrCb) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrCb) - if (.not. allocated(DstRotParameterTypeData%TwrCb)) then - allocate(DstRotParameterTypeData%TwrCb(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%AllOuts)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%AllOuts) + UB(1:1) = ubound(SrcRotMiscVarTypeData%AllOuts) + if (.not. allocated(DstRotMiscVarTypeData%AllOuts)) then + allocate(DstRotMiscVarTypeData%AllOuts(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCb.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%AllOuts.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%TwrCb = SrcRotParameterTypeData%TwrCb + DstRotMiscVarTypeData%AllOuts = SrcRotMiscVarTypeData%AllOuts end if - if (allocated(SrcRotParameterTypeData%BlCenBn)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBn) - UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBn) - if (.not. allocated(DstRotParameterTypeData%BlCenBn)) then - allocate(DstRotParameterTypeData%BlCenBn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%W_Twr)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%W_Twr) + UB(1:1) = ubound(SrcRotMiscVarTypeData%W_Twr) + if (.not. allocated(DstRotMiscVarTypeData%W_Twr)) then + allocate(DstRotMiscVarTypeData%W_Twr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBn.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%W_Twr.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%BlCenBn = SrcRotParameterTypeData%BlCenBn + DstRotMiscVarTypeData%W_Twr = SrcRotMiscVarTypeData%W_Twr end if - if (allocated(SrcRotParameterTypeData%BlCenBt)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBt) - UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBt) - if (.not. allocated(DstRotParameterTypeData%BlCenBt)) then - allocate(DstRotParameterTypeData%BlCenBt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%X_Twr)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%X_Twr) + UB(1:1) = ubound(SrcRotMiscVarTypeData%X_Twr) + if (.not. allocated(DstRotMiscVarTypeData%X_Twr)) then + allocate(DstRotMiscVarTypeData%X_Twr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBt.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%X_Twr.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%BlCenBt = SrcRotParameterTypeData%BlCenBt + DstRotMiscVarTypeData%X_Twr = SrcRotMiscVarTypeData%X_Twr end if - DstRotParameterTypeData%VolHub = SrcRotParameterTypeData%VolHub - DstRotParameterTypeData%HubCenBx = SrcRotParameterTypeData%HubCenBx - DstRotParameterTypeData%VolNac = SrcRotParameterTypeData%VolNac - DstRotParameterTypeData%NacCenB = SrcRotParameterTypeData%NacCenB - DstRotParameterTypeData%NacArea = SrcRotParameterTypeData%NacArea - DstRotParameterTypeData%NacCd = SrcRotParameterTypeData%NacCd - DstRotParameterTypeData%NacDragAC = SrcRotParameterTypeData%NacDragAC - DstRotParameterTypeData%VolBl = SrcRotParameterTypeData%VolBl - DstRotParameterTypeData%VolTwr = SrcRotParameterTypeData%VolTwr - if (allocated(SrcRotParameterTypeData%BlRad)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlRad) - UB(1:2) = ubound(SrcRotParameterTypeData%BlRad) - if (.not. allocated(DstRotParameterTypeData%BlRad)) then - allocate(DstRotParameterTypeData%BlRad(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%Y_Twr)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%Y_Twr) + UB(1:1) = ubound(SrcRotMiscVarTypeData%Y_Twr) + if (.not. allocated(DstRotMiscVarTypeData%Y_Twr)) then + allocate(DstRotMiscVarTypeData%Y_Twr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlRad.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Y_Twr.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%BlRad = SrcRotParameterTypeData%BlRad + DstRotMiscVarTypeData%Y_Twr = SrcRotMiscVarTypeData%Y_Twr end if - if (allocated(SrcRotParameterTypeData%BlDL)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlDL) - UB(1:2) = ubound(SrcRotParameterTypeData%BlDL) - if (.not. allocated(DstRotParameterTypeData%BlDL)) then - allocate(DstRotParameterTypeData%BlDL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%Cant)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Cant) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Cant) + if (.not. allocated(DstRotMiscVarTypeData%Cant)) then + allocate(DstRotMiscVarTypeData%Cant(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlDL.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Cant.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%BlDL = SrcRotParameterTypeData%BlDL + DstRotMiscVarTypeData%Cant = SrcRotMiscVarTypeData%Cant end if - if (allocated(SrcRotParameterTypeData%BlTaper)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlTaper) - UB(1:2) = ubound(SrcRotParameterTypeData%BlTaper) - if (.not. allocated(DstRotParameterTypeData%BlTaper)) then - allocate(DstRotParameterTypeData%BlTaper(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%Toe)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Toe) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Toe) + if (.not. allocated(DstRotMiscVarTypeData%Toe)) then + allocate(DstRotMiscVarTypeData%Toe(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTaper.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Toe.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%BlTaper = SrcRotParameterTypeData%BlTaper + DstRotMiscVarTypeData%Toe = SrcRotMiscVarTypeData%Toe end if - if (allocated(SrcRotParameterTypeData%BlAxCent)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlAxCent) - UB(1:2) = ubound(SrcRotParameterTypeData%BlAxCent) - if (.not. allocated(DstRotParameterTypeData%BlAxCent)) then - allocate(DstRotParameterTypeData%BlAxCent(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%TwrClrnc)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrClrnc) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrClrnc) + if (.not. allocated(DstRotMiscVarTypeData%TwrClrnc)) then + allocate(DstRotMiscVarTypeData%TwrClrnc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlAxCent.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrClrnc.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%BlAxCent = SrcRotParameterTypeData%BlAxCent + DstRotMiscVarTypeData%TwrClrnc = SrcRotMiscVarTypeData%TwrClrnc end if - if (allocated(SrcRotParameterTypeData%TwrRad)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrRad) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrRad) - if (.not. allocated(DstRotParameterTypeData%TwrRad)) then - allocate(DstRotParameterTypeData%TwrRad(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrRad.', ErrStat, ErrMsg, RoutineName) + if (allocated(SrcRotMiscVarTypeData%X)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%X) + UB(1:2) = ubound(SrcRotMiscVarTypeData%X) + if (.not. allocated(DstRotMiscVarTypeData%X)) then + allocate(DstRotMiscVarTypeData%X(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%X.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%TwrRad = SrcRotParameterTypeData%TwrRad + DstRotMiscVarTypeData%X = SrcRotMiscVarTypeData%X end if - if (allocated(SrcRotParameterTypeData%TwrDL)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrDL) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrDL) - if (.not. allocated(DstRotParameterTypeData%TwrDL)) then - allocate(DstRotParameterTypeData%TwrDL(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%Y)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Y) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Y) + if (.not. allocated(DstRotMiscVarTypeData%Y)) then + allocate(DstRotMiscVarTypeData%Y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDL.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Y.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%TwrDL = SrcRotParameterTypeData%TwrDL + DstRotMiscVarTypeData%Y = SrcRotMiscVarTypeData%Y end if - if (allocated(SrcRotParameterTypeData%TwrTaper)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrTaper) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrTaper) - if (.not. allocated(DstRotParameterTypeData%TwrTaper)) then - allocate(DstRotParameterTypeData%TwrTaper(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%Z)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Z) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Z) + if (.not. allocated(DstRotMiscVarTypeData%Z)) then + allocate(DstRotMiscVarTypeData%Z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTaper.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Z.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%TwrTaper = SrcRotParameterTypeData%TwrTaper + DstRotMiscVarTypeData%Z = SrcRotMiscVarTypeData%Z end if - if (allocated(SrcRotParameterTypeData%TwrAxCent)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrAxCent) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrAxCent) - if (.not. allocated(DstRotParameterTypeData%TwrAxCent)) then - allocate(DstRotParameterTypeData%TwrAxCent(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%M)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%M) + UB(1:2) = ubound(SrcRotMiscVarTypeData%M) + if (.not. allocated(DstRotMiscVarTypeData%M)) then + allocate(DstRotMiscVarTypeData%M(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrAxCent.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%M.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%TwrAxCent = SrcRotParameterTypeData%TwrAxCent + DstRotMiscVarTypeData%M = SrcRotMiscVarTypeData%M end if - call BEMT_CopyParam(SrcRotParameterTypeData%BEMT, DstRotParameterTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call AA_CopyParam(SrcRotParameterTypeData%AA, DstRotParameterTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcRotParameterTypeData%Jac_u_indx)) then - LB(1:2) = lbound(SrcRotParameterTypeData%Jac_u_indx) - UB(1:2) = ubound(SrcRotParameterTypeData%Jac_u_indx) - if (.not. allocated(DstRotParameterTypeData%Jac_u_indx)) then - allocate(DstRotParameterTypeData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%Mx)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Mx) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Mx) + if (.not. allocated(DstRotMiscVarTypeData%Mx)) then + allocate(DstRotMiscVarTypeData%Mx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Mx.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%Jac_u_indx = SrcRotParameterTypeData%Jac_u_indx + DstRotMiscVarTypeData%Mx = SrcRotMiscVarTypeData%Mx end if - call AD_CopyJac_u_idxStarts(SrcRotParameterTypeData%Jac_u_idxStartList, DstRotParameterTypeData%Jac_u_idxStartList, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call AD_CopyJac_y_idxStarts(SrcRotParameterTypeData%Jac_y_idxStartList, DstRotParameterTypeData%Jac_y_idxStartList, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - DstRotParameterTypeData%NumExtendedInputs = SrcRotParameterTypeData%NumExtendedInputs - if (allocated(SrcRotParameterTypeData%du)) then - LB(1:1) = lbound(SrcRotParameterTypeData%du) - UB(1:1) = ubound(SrcRotParameterTypeData%du) - if (.not. allocated(DstRotParameterTypeData%du)) then - allocate(DstRotParameterTypeData%du(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%My)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%My) + UB(1:2) = ubound(SrcRotMiscVarTypeData%My) + if (.not. allocated(DstRotMiscVarTypeData%My)) then + allocate(DstRotMiscVarTypeData%My(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%du.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%My.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%du = SrcRotParameterTypeData%du + DstRotMiscVarTypeData%My = SrcRotMiscVarTypeData%My end if - if (allocated(SrcRotParameterTypeData%dx)) then - LB(1:1) = lbound(SrcRotParameterTypeData%dx) - UB(1:1) = ubound(SrcRotParameterTypeData%dx) - if (.not. allocated(DstRotParameterTypeData%dx)) then - allocate(DstRotParameterTypeData%dx(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%Mz)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Mz) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Mz) + if (.not. allocated(DstRotMiscVarTypeData%Mz)) then + allocate(DstRotMiscVarTypeData%Mz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%dx.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Mz.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%dx = SrcRotParameterTypeData%dx + DstRotMiscVarTypeData%Mz = SrcRotMiscVarTypeData%Mz end if - DstRotParameterTypeData%Jac_ny = SrcRotParameterTypeData%Jac_ny - DstRotParameterTypeData%NumBl_Lin = SrcRotParameterTypeData%NumBl_Lin - DstRotParameterTypeData%TwrPotent = SrcRotParameterTypeData%TwrPotent - DstRotParameterTypeData%TwrShadow = SrcRotParameterTypeData%TwrShadow - DstRotParameterTypeData%TwrAero = SrcRotParameterTypeData%TwrAero - DstRotParameterTypeData%DBEMT_Mod = SrcRotParameterTypeData%DBEMT_Mod - DstRotParameterTypeData%CavitCheck = SrcRotParameterTypeData%CavitCheck - DstRotParameterTypeData%Buoyancy = SrcRotParameterTypeData%Buoyancy - DstRotParameterTypeData%NacelleDrag = SrcRotParameterTypeData%NacelleDrag - DstRotParameterTypeData%MHK = SrcRotParameterTypeData%MHK - DstRotParameterTypeData%CompAA = SrcRotParameterTypeData%CompAA - DstRotParameterTypeData%AirDens = SrcRotParameterTypeData%AirDens - DstRotParameterTypeData%KinVisc = SrcRotParameterTypeData%KinVisc - DstRotParameterTypeData%SpdSound = SrcRotParameterTypeData%SpdSound - DstRotParameterTypeData%Gravity = SrcRotParameterTypeData%Gravity - DstRotParameterTypeData%Patm = SrcRotParameterTypeData%Patm - DstRotParameterTypeData%Pvap = SrcRotParameterTypeData%Pvap - DstRotParameterTypeData%WtrDpth = SrcRotParameterTypeData%WtrDpth - DstRotParameterTypeData%MSL2SWL = SrcRotParameterTypeData%MSL2SWL - DstRotParameterTypeData%AeroProjMod = SrcRotParameterTypeData%AeroProjMod - DstRotParameterTypeData%BEM_Mod = SrcRotParameterTypeData%BEM_Mod - DstRotParameterTypeData%NumOuts = SrcRotParameterTypeData%NumOuts - DstRotParameterTypeData%RootName = SrcRotParameterTypeData%RootName - if (allocated(SrcRotParameterTypeData%OutParam)) then - LB(1:1) = lbound(SrcRotParameterTypeData%OutParam) - UB(1:1) = ubound(SrcRotParameterTypeData%OutParam) - if (.not. allocated(DstRotParameterTypeData%OutParam)) then - allocate(DstRotParameterTypeData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%Vind_i)) then + LB(1:3) = lbound(SrcRotMiscVarTypeData%Vind_i) + UB(1:3) = ubound(SrcRotMiscVarTypeData%Vind_i) + if (.not. allocated(DstRotMiscVarTypeData%Vind_i)) then + allocate(DstRotMiscVarTypeData%Vind_i(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%OutParam.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Vind_i.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call NWTC_Library_CopyOutParmType(SrcRotParameterTypeData%OutParam(i1), DstRotParameterTypeData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstRotMiscVarTypeData%Vind_i = SrcRotMiscVarTypeData%Vind_i end if - DstRotParameterTypeData%NBlOuts = SrcRotParameterTypeData%NBlOuts - DstRotParameterTypeData%BlOutNd = SrcRotParameterTypeData%BlOutNd - DstRotParameterTypeData%NTwOuts = SrcRotParameterTypeData%NTwOuts - DstRotParameterTypeData%TwOutNd = SrcRotParameterTypeData%TwOutNd - DstRotParameterTypeData%BldNd_NumOuts = SrcRotParameterTypeData%BldNd_NumOuts - DstRotParameterTypeData%BldNd_TotNumOuts = SrcRotParameterTypeData%BldNd_TotNumOuts - if (allocated(SrcRotParameterTypeData%BldNd_OutParam)) then - LB(1:1) = lbound(SrcRotParameterTypeData%BldNd_OutParam) - UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_OutParam) - if (.not. allocated(DstRotParameterTypeData%BldNd_OutParam)) then - allocate(DstRotParameterTypeData%BldNd_OutParam(LB(1):UB(1)), stat=ErrStat2) + DstRotMiscVarTypeData%V_DiskAvg = SrcRotMiscVarTypeData%V_DiskAvg + DstRotMiscVarTypeData%yaw = SrcRotMiscVarTypeData%yaw + DstRotMiscVarTypeData%tilt = SrcRotMiscVarTypeData%tilt + if (allocated(SrcRotMiscVarTypeData%hub_theta_x_root)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%hub_theta_x_root) + UB(1:1) = ubound(SrcRotMiscVarTypeData%hub_theta_x_root) + if (.not. allocated(DstRotMiscVarTypeData%hub_theta_x_root)) then + allocate(DstRotMiscVarTypeData%hub_theta_x_root(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BldNd_OutParam.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%hub_theta_x_root.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%hub_theta_x_root = SrcRotMiscVarTypeData%hub_theta_x_root + end if + DstRotMiscVarTypeData%V_dot_x = SrcRotMiscVarTypeData%V_dot_x + call MeshCopy(SrcRotMiscVarTypeData%HubLoad, DstRotMiscVarTypeData%HubLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotMiscVarTypeData%B_L_2_H_P)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_H_P) + UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_H_P) + if (.not. allocated(DstRotMiscVarTypeData%B_L_2_H_P)) then + allocate(DstRotMiscVarTypeData%B_L_2_H_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_L_2_H_P.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call NWTC_Library_CopyOutParmType(SrcRotParameterTypeData%BldNd_OutParam(i1), DstRotParameterTypeData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%B_L_2_H_P(i1), DstRotMiscVarTypeData%B_L_2_H_P(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcRotParameterTypeData%BldNd_BlOutNd)) then - LB(1:1) = lbound(SrcRotParameterTypeData%BldNd_BlOutNd) - UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_BlOutNd) - if (.not. allocated(DstRotParameterTypeData%BldNd_BlOutNd)) then - allocate(DstRotParameterTypeData%BldNd_BlOutNd(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%SigmaCavitCrit)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavitCrit) + UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavitCrit) + if (.not. allocated(DstRotMiscVarTypeData%SigmaCavitCrit)) then + allocate(DstRotMiscVarTypeData%SigmaCavitCrit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BldNd_BlOutNd.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%SigmaCavitCrit.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotParameterTypeData%BldNd_BlOutNd = SrcRotParameterTypeData%BldNd_BlOutNd - end if - DstRotParameterTypeData%BldNd_BladesOut = SrcRotParameterTypeData%BldNd_BladesOut - DstRotParameterTypeData%BldNd_NumNodesOut = SrcRotParameterTypeData%BldNd_NumNodesOut - DstRotParameterTypeData%TFinAero = SrcRotParameterTypeData%TFinAero - call AD_CopyTFinParameterType(SrcRotParameterTypeData%TFin, DstRotParameterTypeData%TFin, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return -end subroutine - -subroutine AD_DestroyRotParameterType(RotParameterTypeData, ErrStat, ErrMsg) - type(RotParameterType), intent(inout) :: RotParameterTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_DestroyRotParameterType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(RotParameterTypeData%TwrDiam)) then - deallocate(RotParameterTypeData%TwrDiam) - end if - if (allocated(RotParameterTypeData%TwrCd)) then - deallocate(RotParameterTypeData%TwrCd) + DstRotMiscVarTypeData%SigmaCavitCrit = SrcRotMiscVarTypeData%SigmaCavitCrit end if - if (allocated(RotParameterTypeData%TwrTI)) then - deallocate(RotParameterTypeData%TwrTI) + if (allocated(SrcRotMiscVarTypeData%SigmaCavit)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavit) + UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavit) + if (.not. allocated(DstRotMiscVarTypeData%SigmaCavit)) then + allocate(DstRotMiscVarTypeData%SigmaCavit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%SigmaCavit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%SigmaCavit = SrcRotMiscVarTypeData%SigmaCavit end if - if (allocated(RotParameterTypeData%BlTwist)) then - deallocate(RotParameterTypeData%BlTwist) + if (allocated(SrcRotMiscVarTypeData%CavitWarnSet)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%CavitWarnSet) + UB(1:2) = ubound(SrcRotMiscVarTypeData%CavitWarnSet) + if (.not. allocated(DstRotMiscVarTypeData%CavitWarnSet)) then + allocate(DstRotMiscVarTypeData%CavitWarnSet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%CavitWarnSet.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%CavitWarnSet = SrcRotMiscVarTypeData%CavitWarnSet end if - if (allocated(RotParameterTypeData%TwrCb)) then - deallocate(RotParameterTypeData%TwrCb) + if (allocated(SrcRotMiscVarTypeData%TwrFB)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrFB) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrFB) + if (.not. allocated(DstRotMiscVarTypeData%TwrFB)) then + allocate(DstRotMiscVarTypeData%TwrFB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrFB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%TwrFB = SrcRotMiscVarTypeData%TwrFB end if - if (allocated(RotParameterTypeData%BlCenBn)) then - deallocate(RotParameterTypeData%BlCenBn) - end if - if (allocated(RotParameterTypeData%BlCenBt)) then - deallocate(RotParameterTypeData%BlCenBt) - end if - if (allocated(RotParameterTypeData%BlRad)) then - deallocate(RotParameterTypeData%BlRad) - end if - if (allocated(RotParameterTypeData%BlDL)) then - deallocate(RotParameterTypeData%BlDL) - end if - if (allocated(RotParameterTypeData%BlTaper)) then - deallocate(RotParameterTypeData%BlTaper) - end if - if (allocated(RotParameterTypeData%BlAxCent)) then - deallocate(RotParameterTypeData%BlAxCent) - end if - if (allocated(RotParameterTypeData%TwrRad)) then - deallocate(RotParameterTypeData%TwrRad) - end if - if (allocated(RotParameterTypeData%TwrDL)) then - deallocate(RotParameterTypeData%TwrDL) - end if - if (allocated(RotParameterTypeData%TwrTaper)) then - deallocate(RotParameterTypeData%TwrTaper) - end if - if (allocated(RotParameterTypeData%TwrAxCent)) then - deallocate(RotParameterTypeData%TwrAxCent) - end if - call BEMT_DestroyParam(RotParameterTypeData%BEMT, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AA_DestroyParam(RotParameterTypeData%AA, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(RotParameterTypeData%Jac_u_indx)) then - deallocate(RotParameterTypeData%Jac_u_indx) - end if - call AD_DestroyJac_u_idxStarts(RotParameterTypeData%Jac_u_idxStartList, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AD_DestroyJac_y_idxStarts(RotParameterTypeData%Jac_y_idxStartList, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(RotParameterTypeData%du)) then - deallocate(RotParameterTypeData%du) - end if - if (allocated(RotParameterTypeData%dx)) then - deallocate(RotParameterTypeData%dx) - end if - if (allocated(RotParameterTypeData%OutParam)) then - LB(1:1) = lbound(RotParameterTypeData%OutParam) - UB(1:1) = ubound(RotParameterTypeData%OutParam) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyOutParmType(RotParameterTypeData%OutParam(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(RotParameterTypeData%OutParam) - end if - if (allocated(RotParameterTypeData%BldNd_OutParam)) then - LB(1:1) = lbound(RotParameterTypeData%BldNd_OutParam) - UB(1:1) = ubound(RotParameterTypeData%BldNd_OutParam) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyOutParmType(RotParameterTypeData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(RotParameterTypeData%BldNd_OutParam) + if (allocated(SrcRotMiscVarTypeData%TwrMB)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrMB) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrMB) + if (.not. allocated(DstRotMiscVarTypeData%TwrMB)) then + allocate(DstRotMiscVarTypeData%TwrMB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrMB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%TwrMB = SrcRotMiscVarTypeData%TwrMB end if - if (allocated(RotParameterTypeData%BldNd_BlOutNd)) then - deallocate(RotParameterTypeData%BldNd_BlOutNd) + if (allocated(SrcRotMiscVarTypeData%HubFB)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%HubFB) + UB(1:1) = ubound(SrcRotMiscVarTypeData%HubFB) + if (.not. allocated(DstRotMiscVarTypeData%HubFB)) then + allocate(DstRotMiscVarTypeData%HubFB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%HubFB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%HubFB = SrcRotMiscVarTypeData%HubFB end if - call AD_DestroyTFinParameterType(RotParameterTypeData%TFin, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -end subroutine - -subroutine AD_PackRotParameterType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(RotParameterType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackRotParameterType' - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%NumBlades) - call RegPack(RF, InData%NumBlNds) - call RegPack(RF, InData%NumTwrNds) - call RegPackAlloc(RF, InData%TwrDiam) - call RegPackAlloc(RF, InData%TwrCd) - call RegPackAlloc(RF, InData%TwrTI) - call RegPackAlloc(RF, InData%BlTwist) - call RegPackAlloc(RF, InData%TwrCb) - call RegPackAlloc(RF, InData%BlCenBn) - call RegPackAlloc(RF, InData%BlCenBt) - call RegPack(RF, InData%VolHub) - call RegPack(RF, InData%HubCenBx) - call RegPack(RF, InData%VolNac) - call RegPack(RF, InData%NacCenB) - call RegPack(RF, InData%NacArea) - call RegPack(RF, InData%NacCd) - call RegPack(RF, InData%NacDragAC) - call RegPack(RF, InData%VolBl) - call RegPack(RF, InData%VolTwr) - call RegPackAlloc(RF, InData%BlRad) - call RegPackAlloc(RF, InData%BlDL) - call RegPackAlloc(RF, InData%BlTaper) - call RegPackAlloc(RF, InData%BlAxCent) - call RegPackAlloc(RF, InData%TwrRad) - call RegPackAlloc(RF, InData%TwrDL) - call RegPackAlloc(RF, InData%TwrTaper) - call RegPackAlloc(RF, InData%TwrAxCent) - call BEMT_PackParam(RF, InData%BEMT) - call AA_PackParam(RF, InData%AA) - call RegPackAlloc(RF, InData%Jac_u_indx) - call AD_PackJac_u_idxStarts(RF, InData%Jac_u_idxStartList) - call AD_PackJac_y_idxStarts(RF, InData%Jac_y_idxStartList) - call RegPack(RF, InData%NumExtendedInputs) - call RegPackAlloc(RF, InData%du) - call RegPackAlloc(RF, InData%dx) - call RegPack(RF, InData%Jac_ny) - call RegPack(RF, InData%NumBl_Lin) - call RegPack(RF, InData%TwrPotent) - call RegPack(RF, InData%TwrShadow) - call RegPack(RF, InData%TwrAero) - call RegPack(RF, InData%DBEMT_Mod) - call RegPack(RF, InData%CavitCheck) - call RegPack(RF, InData%Buoyancy) - call RegPack(RF, InData%NacelleDrag) - call RegPack(RF, InData%MHK) - call RegPack(RF, InData%CompAA) - call RegPack(RF, InData%AirDens) - call RegPack(RF, InData%KinVisc) - call RegPack(RF, InData%SpdSound) - call RegPack(RF, InData%Gravity) - call RegPack(RF, InData%Patm) - call RegPack(RF, InData%Pvap) - call RegPack(RF, InData%WtrDpth) - call RegPack(RF, InData%MSL2SWL) - call RegPack(RF, InData%AeroProjMod) - call RegPack(RF, InData%BEM_Mod) - call RegPack(RF, InData%NumOuts) - call RegPack(RF, InData%RootName) - call RegPack(RF, allocated(InData%OutParam)) - if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) - LB(1:1) = lbound(InData%OutParam) - UB(1:1) = ubound(InData%OutParam) - do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) - end do + if (allocated(SrcRotMiscVarTypeData%HubMB)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%HubMB) + UB(1:1) = ubound(SrcRotMiscVarTypeData%HubMB) + if (.not. allocated(DstRotMiscVarTypeData%HubMB)) then + allocate(DstRotMiscVarTypeData%HubMB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%HubMB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%HubMB = SrcRotMiscVarTypeData%HubMB end if - call RegPack(RF, InData%NBlOuts) - call RegPack(RF, InData%BlOutNd) - call RegPack(RF, InData%NTwOuts) - call RegPack(RF, InData%TwOutNd) - call RegPack(RF, InData%BldNd_NumOuts) - call RegPack(RF, InData%BldNd_TotNumOuts) - call RegPack(RF, allocated(InData%BldNd_OutParam)) - if (allocated(InData%BldNd_OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%BldNd_OutParam), ubound(InData%BldNd_OutParam)) - LB(1:1) = lbound(InData%BldNd_OutParam) - UB(1:1) = ubound(InData%BldNd_OutParam) - do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(RF, InData%BldNd_OutParam(i1)) - end do + if (allocated(SrcRotMiscVarTypeData%NacFB)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacFB) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacFB) + if (.not. allocated(DstRotMiscVarTypeData%NacFB)) then + allocate(DstRotMiscVarTypeData%NacFB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacFB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%NacFB = SrcRotMiscVarTypeData%NacFB end if - call RegPackAlloc(RF, InData%BldNd_BlOutNd) - call RegPack(RF, InData%BldNd_BladesOut) - call RegPack(RF, InData%BldNd_NumNodesOut) - call RegPack(RF, InData%TFinAero) - call AD_PackTFinParameterType(RF, InData%TFin) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AD_UnPackRotParameterType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(RotParameterType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackRotParameterType' - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%NumBlades); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumBlNds); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumTwrNds); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TwrDiam); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TwrCd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TwrTI); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlTwist); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TwrCb); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlCenBn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlCenBt); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VolHub); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%HubCenBx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VolNac); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NacCenB); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NacArea); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NacCd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NacDragAC); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VolBl); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VolTwr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlRad); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlDL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlTaper); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlAxCent); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TwrRad); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TwrDL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TwrTaper); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TwrAxCent); if (RegCheckErr(RF, RoutineName)) return - call BEMT_UnpackParam(RF, OutData%BEMT) ! BEMT - call AA_UnpackParam(RF, OutData%AA) ! AA - call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return - call AD_UnpackJac_u_idxStarts(RF, OutData%Jac_u_idxStartList) ! Jac_u_idxStartList - call AD_UnpackJac_y_idxStarts(RF, OutData%Jac_y_idxStartList) ! Jac_y_idxStartList - call RegUnpack(RF, OutData%NumExtendedInputs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumBl_Lin); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TwrPotent); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TwrShadow); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TwrAero); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%DBEMT_Mod); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%CavitCheck); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Buoyancy); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NacelleDrag); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%CompAA); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SpdSound); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Patm); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Pvap); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AeroProjMod); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%BEM_Mod); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + if (allocated(SrcRotMiscVarTypeData%NacMB)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacMB) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacMB) + if (.not. allocated(DstRotMiscVarTypeData%NacMB)) then + allocate(DstRotMiscVarTypeData%NacMB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacMB.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam - end do + DstRotMiscVarTypeData%NacMB = SrcRotMiscVarTypeData%NacMB end if - call RegUnpack(RF, OutData%NBlOuts); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%BlOutNd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NTwOuts); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TwOutNd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%BldNd_NumOuts); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%BldNd_TotNumOuts); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%BldNd_OutParam)) deallocate(OutData%BldNd_OutParam) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BldNd_OutParam(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + if (allocated(SrcRotMiscVarTypeData%NacDragF)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacDragF) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacDragF) + if (.not. allocated(DstRotMiscVarTypeData%NacDragF)) then + allocate(DstRotMiscVarTypeData%NacDragF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacDragF.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(RF, OutData%BldNd_OutParam(i1)) ! BldNd_OutParam - end do + DstRotMiscVarTypeData%NacDragF = SrcRotMiscVarTypeData%NacDragF end if - call RegUnpackAlloc(RF, OutData%BldNd_BlOutNd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%BldNd_BladesOut); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%BldNd_NumNodesOut); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinAero); if (RegCheckErr(RF, RoutineName)) return - call AD_UnpackTFinParameterType(RF, OutData%TFin) ! TFin -end subroutine - -subroutine AD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) - type(AD_ParameterType), intent(in) :: SrcParamData - type(AD_ParameterType), intent(inout) :: DstParamData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyParam' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcParamData%rotors)) then - LB(1:1) = lbound(SrcParamData%rotors) - UB(1:1) = ubound(SrcParamData%rotors) - if (.not. allocated(DstParamData%rotors)) then - allocate(DstParamData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%NacDragM)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacDragM) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacDragM) + if (.not. allocated(DstRotMiscVarTypeData%NacDragM)) then + allocate(DstRotMiscVarTypeData%NacDragM(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotors.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacDragM.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call AD_CopyRotParameterType(SrcParamData%rotors(i1), DstParamData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstRotMiscVarTypeData%NacDragM = SrcRotMiscVarTypeData%NacDragM end if - DstParamData%DT = SrcParamData%DT - DstParamData%RootName = SrcParamData%RootName - if (allocated(SrcParamData%AFI)) then - LB(1:1) = lbound(SrcParamData%AFI) - UB(1:1) = ubound(SrcParamData%AFI) - if (.not. allocated(DstParamData%AFI)) then - allocate(DstParamData%AFI(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%NacFi)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacFi) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacFi) + if (.not. allocated(DstRotMiscVarTypeData%NacFi)) then + allocate(DstRotMiscVarTypeData%NacFi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFI.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacFi.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call AFI_CopyParam(SrcParamData%AFI(i1), DstParamData%AFI(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - DstParamData%Skew_Mod = SrcParamData%Skew_Mod - DstParamData%Wake_Mod = SrcParamData%Wake_Mod - call FVW_CopyParam(SrcParamData%FVW, DstParamData%FVW, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - DstParamData%CompAeroMaps = SrcParamData%CompAeroMaps - DstParamData%UA_Flag = SrcParamData%UA_Flag - DstParamData%FlowField => SrcParamData%FlowField - DstParamData%SectAvg = SrcParamData%SectAvg - DstParamData%SA_Weighting = SrcParamData%SA_Weighting - DstParamData%SA_PsiBwd = SrcParamData%SA_PsiBwd - DstParamData%SA_PsiFwd = SrcParamData%SA_PsiFwd - DstParamData%SA_nPerSec = SrcParamData%SA_nPerSec -end subroutine - -subroutine AD_DestroyParam(ParamData, ErrStat, ErrMsg) - type(AD_ParameterType), intent(inout) :: ParamData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_DestroyParam' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(ParamData%rotors)) then - LB(1:1) = lbound(ParamData%rotors) - UB(1:1) = ubound(ParamData%rotors) - do i1 = LB(1), UB(1) - call AD_DestroyRotParameterType(ParamData%rotors(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ParamData%rotors) + DstRotMiscVarTypeData%NacFi = SrcRotMiscVarTypeData%NacFi end if - if (allocated(ParamData%AFI)) then - LB(1:1) = lbound(ParamData%AFI) - UB(1:1) = ubound(ParamData%AFI) - do i1 = LB(1), UB(1) - call AFI_DestroyParam(ParamData%AFI(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ParamData%AFI) + if (allocated(SrcRotMiscVarTypeData%NacMi)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacMi) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacMi) + if (.not. allocated(DstRotMiscVarTypeData%NacMi)) then + allocate(DstRotMiscVarTypeData%NacMi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacMi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%NacMi = SrcRotMiscVarTypeData%NacMi end if - call FVW_DestroyParam(ParamData%FVW, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - nullify(ParamData%FlowField) -end subroutine - -subroutine AD_PackParam(RF, Indata) - type(RegFile), intent(inout) :: RF - type(AD_ParameterType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackParam' - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - logical :: PtrInIndex - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%rotors)) - if (allocated(InData%rotors)) then - call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) - LB(1:1) = lbound(InData%rotors) - UB(1:1) = ubound(InData%rotors) - do i1 = LB(1), UB(1) - call AD_PackRotParameterType(RF, InData%rotors(i1)) - end do + if (allocated(SrcRotMiscVarTypeData%BlFI)) then + LB(1:3) = lbound(SrcRotMiscVarTypeData%BlFI) + UB(1:3) = ubound(SrcRotMiscVarTypeData%BlFI) + if (.not. allocated(DstRotMiscVarTypeData%BlFI)) then + allocate(DstRotMiscVarTypeData%BlFI(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BlFI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%BlFI = SrcRotMiscVarTypeData%BlFI end if - call RegPack(RF, InData%DT) - call RegPack(RF, InData%RootName) - call RegPack(RF, allocated(InData%AFI)) - if (allocated(InData%AFI)) then - call RegPackBounds(RF, 1, lbound(InData%AFI), ubound(InData%AFI)) - LB(1:1) = lbound(InData%AFI) - UB(1:1) = ubound(InData%AFI) - do i1 = LB(1), UB(1) - call AFI_PackParam(RF, InData%AFI(i1)) - end do + if (allocated(SrcRotMiscVarTypeData%BlFA)) then + LB(1:3) = lbound(SrcRotMiscVarTypeData%BlFA) + UB(1:3) = ubound(SrcRotMiscVarTypeData%BlFA) + if (.not. allocated(DstRotMiscVarTypeData%BlFA)) then + allocate(DstRotMiscVarTypeData%BlFA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BlFA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%BlFA = SrcRotMiscVarTypeData%BlFA end if - call RegPack(RF, InData%Skew_Mod) - call RegPack(RF, InData%Wake_Mod) - call FVW_PackParam(RF, InData%FVW) - call RegPack(RF, InData%CompAeroMaps) - call RegPack(RF, InData%UA_Flag) - call RegPack(RF, associated(InData%FlowField)) - if (associated(InData%FlowField)) then - call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) - if (.not. PtrInIndex) then - call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) + if (allocated(SrcRotMiscVarTypeData%BlMA)) then + LB(1:3) = lbound(SrcRotMiscVarTypeData%BlMA) + UB(1:3) = ubound(SrcRotMiscVarTypeData%BlMA) + if (.not. allocated(DstRotMiscVarTypeData%BlMA)) then + allocate(DstRotMiscVarTypeData%BlMA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BlMA.', ErrStat, ErrMsg, RoutineName) + return + end if end if + DstRotMiscVarTypeData%BlMA = SrcRotMiscVarTypeData%BlMA end if - call RegPack(RF, InData%SectAvg) - call RegPack(RF, InData%SA_Weighting) - call RegPack(RF, InData%SA_PsiBwd) - call RegPack(RF, InData%SA_PsiFwd) - call RegPack(RF, InData%SA_nPerSec) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AD_UnPackParam(RF, OutData) - type(RegFile), intent(inout) :: RF - type(AD_ParameterType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackParam' - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - integer(B8Ki) :: PtrIdx - type(c_ptr) :: Ptr - if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%rotors)) deallocate(OutData%rotors) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%rotors(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + if (allocated(SrcRotMiscVarTypeData%TwrFI)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrFI) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrFI) + if (.not. allocated(DstRotMiscVarTypeData%TwrFI)) then + allocate(DstRotMiscVarTypeData%TwrFI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrFI.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i1 = LB(1), UB(1) - call AD_UnpackRotParameterType(RF, OutData%rotors(i1)) ! rotors - end do + DstRotMiscVarTypeData%TwrFI = SrcRotMiscVarTypeData%TwrFI end if - call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%AFI)) deallocate(OutData%AFI) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%AFI(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFI.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + if (allocated(SrcRotMiscVarTypeData%TwrFA)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrFA) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrFA) + if (.not. allocated(DstRotMiscVarTypeData%TwrFA)) then + allocate(DstRotMiscVarTypeData%TwrFA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrFA.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i1 = LB(1), UB(1) - call AFI_UnpackParam(RF, OutData%AFI(i1)) ! AFI - end do + DstRotMiscVarTypeData%TwrFA = SrcRotMiscVarTypeData%TwrFA end if - call RegUnpack(RF, OutData%Skew_Mod); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Wake_Mod); if (RegCheckErr(RF, RoutineName)) return - call FVW_UnpackParam(RF, OutData%FVW) ! FVW - call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%UA_Flag); if (RegCheckErr(RF, RoutineName)) return - if (associated(OutData%FlowField)) deallocate(OutData%FlowField) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%FlowField) - else - allocate(OutData%FlowField,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) + if (allocated(SrcRotMiscVarTypeData%BladeRootLoad)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeRootLoad) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeRootLoad) + if (.not. allocated(DstRotMiscVarTypeData%BladeRootLoad)) then + allocate(DstRotMiscVarTypeData%BladeRootLoad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeRootLoad.', ErrStat, ErrMsg, RoutineName) return end if - RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) - call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField end if - else - OutData%FlowField => null() + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotMiscVarTypeData%BladeRootLoad(i1), DstRotMiscVarTypeData%BladeRootLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - call RegUnpack(RF, OutData%SectAvg); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SA_Weighting); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SA_PsiBwd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SA_PsiFwd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SA_nPerSec); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCode, ErrStat, ErrMsg) - type(RotInputType), intent(inout) :: SrcRotInputTypeData - type(RotInputType), intent(inout) :: DstRotInputTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyRotInputType' - ErrStat = ErrID_None - ErrMsg = '' - call MeshCopy(SrcRotInputTypeData%NacelleMotion, DstRotInputTypeData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcRotInputTypeData%TowerMotion, DstRotInputTypeData%TowerMotion, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcRotInputTypeData%HubMotion, DstRotInputTypeData%HubMotion, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcRotInputTypeData%BladeRootMotion)) then - LB(1:1) = lbound(SrcRotInputTypeData%BladeRootMotion) - UB(1:1) = ubound(SrcRotInputTypeData%BladeRootMotion) - if (.not. allocated(DstRotInputTypeData%BladeRootMotion)) then - allocate(DstRotInputTypeData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%B_L_2_R_P)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_R_P) + UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_R_P) + if (.not. allocated(DstRotMiscVarTypeData%B_L_2_R_P)) then + allocate(DstRotMiscVarTypeData%B_L_2_R_P(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeRootMotion.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_L_2_R_P.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MeshCopy(SrcRotInputTypeData%BladeRootMotion(i1), DstRotInputTypeData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%B_L_2_R_P(i1), DstRotMiscVarTypeData%B_L_2_R_P(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcRotInputTypeData%BladeMotion)) then - LB(1:1) = lbound(SrcRotInputTypeData%BladeMotion) - UB(1:1) = ubound(SrcRotInputTypeData%BladeMotion) - if (.not. allocated(DstRotInputTypeData%BladeMotion)) then - allocate(DstRotInputTypeData%BladeMotion(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%BladeBuoyLoadPoint)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint) + if (.not. allocated(DstRotMiscVarTypeData%BladeBuoyLoadPoint)) then + allocate(DstRotMiscVarTypeData%BladeBuoyLoadPoint(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeMotion.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoadPoint.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MeshCopy(SrcRotInputTypeData%BladeMotion(i1), DstRotInputTypeData%BladeMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call MeshCopy(SrcRotMiscVarTypeData%BladeBuoyLoadPoint(i1), DstRotMiscVarTypeData%BladeBuoyLoadPoint(i1), CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - call MeshCopy(SrcRotInputTypeData%TFinMotion, DstRotInputTypeData%TFinMotion, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcRotInputTypeData%UserProp)) then - LB(1:2) = lbound(SrcRotInputTypeData%UserProp) - UB(1:2) = ubound(SrcRotInputTypeData%UserProp) - if (.not. allocated(DstRotInputTypeData%UserProp)) then - allocate(DstRotInputTypeData%UserProp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcRotMiscVarTypeData%BladeBuoyLoad)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoad) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoad) + if (.not. allocated(DstRotMiscVarTypeData%BladeBuoyLoad)) then + allocate(DstRotMiscVarTypeData%BladeBuoyLoad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%UserProp.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoad.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotInputTypeData%UserProp = SrcRotInputTypeData%UserProp + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotMiscVarTypeData%BladeBuoyLoad(i1), DstRotMiscVarTypeData%BladeBuoyLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcRotMiscVarTypeData%B_P_2_B_L)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%B_P_2_B_L) + UB(1:1) = ubound(SrcRotMiscVarTypeData%B_P_2_B_L) + if (.not. allocated(DstRotMiscVarTypeData%B_P_2_B_L)) then + allocate(DstRotMiscVarTypeData%B_P_2_B_L(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_P_2_B_L.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%B_P_2_B_L(i1), DstRotMiscVarTypeData%B_P_2_B_L(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if + call MeshCopy(SrcRotMiscVarTypeData%TwrBuoyLoadPoint, DstRotMiscVarTypeData%TwrBuoyLoadPoint, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotMiscVarTypeData%TwrBuoyLoad, DstRotMiscVarTypeData%TwrBuoyLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%T_P_2_T_L, DstRotMiscVarTypeData%T_P_2_T_L, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstRotMiscVarTypeData%FirstWarn_TowerStrike = SrcRotMiscVarTypeData%FirstWarn_TowerStrike + DstRotMiscVarTypeData%AvgDiskVel = SrcRotMiscVarTypeData%AvgDiskVel + DstRotMiscVarTypeData%AvgDiskVelDist = SrcRotMiscVarTypeData%AvgDiskVelDist + DstRotMiscVarTypeData%TFinAlpha = SrcRotMiscVarTypeData%TFinAlpha + DstRotMiscVarTypeData%TFinRe = SrcRotMiscVarTypeData%TFinRe + DstRotMiscVarTypeData%TFinVrel = SrcRotMiscVarTypeData%TFinVrel + DstRotMiscVarTypeData%TFinVund_i = SrcRotMiscVarTypeData%TFinVund_i + DstRotMiscVarTypeData%TFinVind_i = SrcRotMiscVarTypeData%TFinVind_i + DstRotMiscVarTypeData%TFinVrel_i = SrcRotMiscVarTypeData%TFinVrel_i + DstRotMiscVarTypeData%TFinSTV_i = SrcRotMiscVarTypeData%TFinSTV_i + DstRotMiscVarTypeData%TFinF_i = SrcRotMiscVarTypeData%TFinF_i + DstRotMiscVarTypeData%TFinM_i = SrcRotMiscVarTypeData%TFinM_i end subroutine -subroutine AD_DestroyRotInputType(RotInputTypeData, ErrStat, ErrMsg) - type(RotInputType), intent(inout) :: RotInputTypeData +subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) + type(RotMiscVarType), intent(inout) :: RotMiscVarTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_DestroyRotInputType' + character(*), parameter :: RoutineName = 'AD_DestroyRotMiscVarType' ErrStat = ErrID_None ErrMsg = '' - call MeshDestroy( RotInputTypeData%NacelleMotion, ErrStat2, ErrMsg2) + call NWTC_Library_DestroyModJacType(RotMiscVarTypeData%Jac, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( RotInputTypeData%TowerMotion, ErrStat2, ErrMsg2) + call AD_DestroyRotContinuousStateType(RotMiscVarTypeData%x_init, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( RotInputTypeData%HubMotion, ErrStat2, ErrMsg2) + call AD_DestroyRotContinuousStateType(RotMiscVarTypeData%x_perturb, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(RotInputTypeData%BladeRootMotion)) then - LB(1:1) = lbound(RotInputTypeData%BladeRootMotion) - UB(1:1) = ubound(RotInputTypeData%BladeRootMotion) + call AD_DestroyRotContinuousStateType(RotMiscVarTypeData%dxdt_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyRotInputType(RotMiscVarTypeData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyRotOutputType(RotMiscVarTypeData%y_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyRotConstraintStateType(RotMiscVarTypeData%z_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyRotOtherStateType(RotMiscVarTypeData%OtherState_init, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyRotOtherStateType(RotMiscVarTypeData%OtherState_jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call BEMT_DestroyMisc(RotMiscVarTypeData%BEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call BEMT_DestroyOutput(RotMiscVarTypeData%BEMT_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + LB(1:1) = lbound(RotMiscVarTypeData%BEMT_u) + UB(1:1) = ubound(RotMiscVarTypeData%BEMT_u) + do i1 = LB(1), UB(1) + call BEMT_DestroyInput(RotMiscVarTypeData%BEMT_u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call AA_DestroyMisc(RotMiscVarTypeData%AA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyOutput(RotMiscVarTypeData%AA_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyInput(RotMiscVarTypeData%AA_u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotMiscVarTypeData%DisturbedInflow)) then + deallocate(RotMiscVarTypeData%DisturbedInflow) + end if + if (allocated(RotMiscVarTypeData%SectAvgInflow)) then + deallocate(RotMiscVarTypeData%SectAvgInflow) + end if + if (allocated(RotMiscVarTypeData%orientationAnnulus)) then + deallocate(RotMiscVarTypeData%orientationAnnulus) + end if + if (allocated(RotMiscVarTypeData%R_li)) then + deallocate(RotMiscVarTypeData%R_li) + end if + if (allocated(RotMiscVarTypeData%AllOuts)) then + deallocate(RotMiscVarTypeData%AllOuts) + end if + if (allocated(RotMiscVarTypeData%W_Twr)) then + deallocate(RotMiscVarTypeData%W_Twr) + end if + if (allocated(RotMiscVarTypeData%X_Twr)) then + deallocate(RotMiscVarTypeData%X_Twr) + end if + if (allocated(RotMiscVarTypeData%Y_Twr)) then + deallocate(RotMiscVarTypeData%Y_Twr) + end if + if (allocated(RotMiscVarTypeData%Cant)) then + deallocate(RotMiscVarTypeData%Cant) + end if + if (allocated(RotMiscVarTypeData%Toe)) then + deallocate(RotMiscVarTypeData%Toe) + end if + if (allocated(RotMiscVarTypeData%TwrClrnc)) then + deallocate(RotMiscVarTypeData%TwrClrnc) + end if + if (allocated(RotMiscVarTypeData%X)) then + deallocate(RotMiscVarTypeData%X) + end if + if (allocated(RotMiscVarTypeData%Y)) then + deallocate(RotMiscVarTypeData%Y) + end if + if (allocated(RotMiscVarTypeData%Z)) then + deallocate(RotMiscVarTypeData%Z) + end if + if (allocated(RotMiscVarTypeData%M)) then + deallocate(RotMiscVarTypeData%M) + end if + if (allocated(RotMiscVarTypeData%Mx)) then + deallocate(RotMiscVarTypeData%Mx) + end if + if (allocated(RotMiscVarTypeData%My)) then + deallocate(RotMiscVarTypeData%My) + end if + if (allocated(RotMiscVarTypeData%Mz)) then + deallocate(RotMiscVarTypeData%Mz) + end if + if (allocated(RotMiscVarTypeData%Vind_i)) then + deallocate(RotMiscVarTypeData%Vind_i) + end if + if (allocated(RotMiscVarTypeData%hub_theta_x_root)) then + deallocate(RotMiscVarTypeData%hub_theta_x_root) + end if + call MeshDestroy( RotMiscVarTypeData%HubLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotMiscVarTypeData%B_L_2_H_P)) then + LB(1:1) = lbound(RotMiscVarTypeData%B_L_2_H_P) + UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_H_P) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_L_2_H_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotMiscVarTypeData%B_L_2_H_P) + end if + if (allocated(RotMiscVarTypeData%SigmaCavitCrit)) then + deallocate(RotMiscVarTypeData%SigmaCavitCrit) + end if + if (allocated(RotMiscVarTypeData%SigmaCavit)) then + deallocate(RotMiscVarTypeData%SigmaCavit) + end if + if (allocated(RotMiscVarTypeData%CavitWarnSet)) then + deallocate(RotMiscVarTypeData%CavitWarnSet) + end if + if (allocated(RotMiscVarTypeData%TwrFB)) then + deallocate(RotMiscVarTypeData%TwrFB) + end if + if (allocated(RotMiscVarTypeData%TwrMB)) then + deallocate(RotMiscVarTypeData%TwrMB) + end if + if (allocated(RotMiscVarTypeData%HubFB)) then + deallocate(RotMiscVarTypeData%HubFB) + end if + if (allocated(RotMiscVarTypeData%HubMB)) then + deallocate(RotMiscVarTypeData%HubMB) + end if + if (allocated(RotMiscVarTypeData%NacFB)) then + deallocate(RotMiscVarTypeData%NacFB) + end if + if (allocated(RotMiscVarTypeData%NacMB)) then + deallocate(RotMiscVarTypeData%NacMB) + end if + if (allocated(RotMiscVarTypeData%NacDragF)) then + deallocate(RotMiscVarTypeData%NacDragF) + end if + if (allocated(RotMiscVarTypeData%NacDragM)) then + deallocate(RotMiscVarTypeData%NacDragM) + end if + if (allocated(RotMiscVarTypeData%NacFi)) then + deallocate(RotMiscVarTypeData%NacFi) + end if + if (allocated(RotMiscVarTypeData%NacMi)) then + deallocate(RotMiscVarTypeData%NacMi) + end if + if (allocated(RotMiscVarTypeData%BlFI)) then + deallocate(RotMiscVarTypeData%BlFI) + end if + if (allocated(RotMiscVarTypeData%BlFA)) then + deallocate(RotMiscVarTypeData%BlFA) + end if + if (allocated(RotMiscVarTypeData%BlMA)) then + deallocate(RotMiscVarTypeData%BlMA) + end if + if (allocated(RotMiscVarTypeData%TwrFI)) then + deallocate(RotMiscVarTypeData%TwrFI) + end if + if (allocated(RotMiscVarTypeData%TwrFA)) then + deallocate(RotMiscVarTypeData%TwrFA) + end if + if (allocated(RotMiscVarTypeData%BladeRootLoad)) then + LB(1:1) = lbound(RotMiscVarTypeData%BladeRootLoad) + UB(1:1) = ubound(RotMiscVarTypeData%BladeRootLoad) + do i1 = LB(1), UB(1) + call MeshDestroy( RotMiscVarTypeData%BladeRootLoad(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotMiscVarTypeData%BladeRootLoad) + end if + if (allocated(RotMiscVarTypeData%B_L_2_R_P)) then + LB(1:1) = lbound(RotMiscVarTypeData%B_L_2_R_P) + UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_R_P) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_L_2_R_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotMiscVarTypeData%B_L_2_R_P) + end if + if (allocated(RotMiscVarTypeData%BladeBuoyLoadPoint)) then + LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoadPoint) + UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoadPoint) + do i1 = LB(1), UB(1) + call MeshDestroy( RotMiscVarTypeData%BladeBuoyLoadPoint(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotMiscVarTypeData%BladeBuoyLoadPoint) + end if + if (allocated(RotMiscVarTypeData%BladeBuoyLoad)) then + LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoad) + UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoad) do i1 = LB(1), UB(1) - call MeshDestroy( RotInputTypeData%BladeRootMotion(i1), ErrStat2, ErrMsg2) + call MeshDestroy( RotMiscVarTypeData%BladeBuoyLoad(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(RotInputTypeData%BladeRootMotion) + deallocate(RotMiscVarTypeData%BladeBuoyLoad) end if - if (allocated(RotInputTypeData%BladeMotion)) then - LB(1:1) = lbound(RotInputTypeData%BladeMotion) - UB(1:1) = ubound(RotInputTypeData%BladeMotion) + if (allocated(RotMiscVarTypeData%B_P_2_B_L)) then + LB(1:1) = lbound(RotMiscVarTypeData%B_P_2_B_L) + UB(1:1) = ubound(RotMiscVarTypeData%B_P_2_B_L) do i1 = LB(1), UB(1) - call MeshDestroy( RotInputTypeData%BladeMotion(i1), ErrStat2, ErrMsg2) + call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_P_2_B_L(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(RotInputTypeData%BladeMotion) + deallocate(RotMiscVarTypeData%B_P_2_B_L) end if - call MeshDestroy( RotInputTypeData%TFinMotion, ErrStat2, ErrMsg2) + call MeshDestroy( RotMiscVarTypeData%TwrBuoyLoadPoint, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotMiscVarTypeData%TwrBuoyLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%T_P_2_T_L, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(RotInputTypeData%UserProp)) then - deallocate(RotInputTypeData%UserProp) - end if end subroutine -subroutine AD_PackRotInputType(RF, Indata) +subroutine AD_PackRotMiscVarType(RF, Indata) type(RegFile), intent(inout) :: RF - type(RotInputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackRotInputType' - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) + type(RotMiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotMiscVarType' + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) if (RF%ErrStat >= AbortErrLev) return - call MeshPack(RF, InData%NacelleMotion) - call MeshPack(RF, InData%TowerMotion) - call MeshPack(RF, InData%HubMotion) - call RegPack(RF, allocated(InData%BladeRootMotion)) - if (allocated(InData%BladeRootMotion)) then - call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) - LB(1:1) = lbound(InData%BladeRootMotion) - UB(1:1) = ubound(InData%BladeRootMotion) + call NWTC_Library_PackModJacType(RF, InData%Jac) + call AD_PackRotContinuousStateType(RF, InData%x_init) + call AD_PackRotContinuousStateType(RF, InData%x_perturb) + call AD_PackRotContinuousStateType(RF, InData%dxdt_lin) + call AD_PackRotInputType(RF, InData%u_perturb) + call AD_PackRotOutputType(RF, InData%y_lin) + call AD_PackRotConstraintStateType(RF, InData%z_lin) + call AD_PackRotOtherStateType(RF, InData%OtherState_init) + call AD_PackRotOtherStateType(RF, InData%OtherState_jac) + call BEMT_PackMisc(RF, InData%BEMT) + call BEMT_PackOutput(RF, InData%BEMT_y) + LB(1:1) = lbound(InData%BEMT_u) + UB(1:1) = ubound(InData%BEMT_u) + do i1 = LB(1), UB(1) + call BEMT_PackInput(RF, InData%BEMT_u(i1)) + end do + call AA_PackMisc(RF, InData%AA) + call AA_PackOutput(RF, InData%AA_y) + call AA_PackInput(RF, InData%AA_u) + call RegPackAlloc(RF, InData%DisturbedInflow) + call RegPackAlloc(RF, InData%SectAvgInflow) + call RegPackAlloc(RF, InData%orientationAnnulus) + call RegPackAlloc(RF, InData%R_li) + call RegPackAlloc(RF, InData%AllOuts) + call RegPackAlloc(RF, InData%W_Twr) + call RegPackAlloc(RF, InData%X_Twr) + call RegPackAlloc(RF, InData%Y_Twr) + call RegPackAlloc(RF, InData%Cant) + call RegPackAlloc(RF, InData%Toe) + call RegPackAlloc(RF, InData%TwrClrnc) + call RegPackAlloc(RF, InData%X) + call RegPackAlloc(RF, InData%Y) + call RegPackAlloc(RF, InData%Z) + call RegPackAlloc(RF, InData%M) + call RegPackAlloc(RF, InData%Mx) + call RegPackAlloc(RF, InData%My) + call RegPackAlloc(RF, InData%Mz) + call RegPackAlloc(RF, InData%Vind_i) + call RegPack(RF, InData%V_DiskAvg) + call RegPack(RF, InData%yaw) + call RegPack(RF, InData%tilt) + call RegPackAlloc(RF, InData%hub_theta_x_root) + call RegPack(RF, InData%V_dot_x) + call MeshPack(RF, InData%HubLoad) + call RegPack(RF, allocated(InData%B_L_2_H_P)) + if (allocated(InData%B_L_2_H_P)) then + call RegPackBounds(RF, 1, lbound(InData%B_L_2_H_P), ubound(InData%B_L_2_H_P)) + LB(1:1) = lbound(InData%B_L_2_H_P) + UB(1:1) = ubound(InData%B_L_2_H_P) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%BladeRootMotion(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%B_L_2_H_P(i1)) end do end if - call RegPack(RF, allocated(InData%BladeMotion)) - if (allocated(InData%BladeMotion)) then - call RegPackBounds(RF, 1, lbound(InData%BladeMotion), ubound(InData%BladeMotion)) - LB(1:1) = lbound(InData%BladeMotion) - UB(1:1) = ubound(InData%BladeMotion) + call RegPackAlloc(RF, InData%SigmaCavitCrit) + call RegPackAlloc(RF, InData%SigmaCavit) + call RegPackAlloc(RF, InData%CavitWarnSet) + call RegPackAlloc(RF, InData%TwrFB) + call RegPackAlloc(RF, InData%TwrMB) + call RegPackAlloc(RF, InData%HubFB) + call RegPackAlloc(RF, InData%HubMB) + call RegPackAlloc(RF, InData%NacFB) + call RegPackAlloc(RF, InData%NacMB) + call RegPackAlloc(RF, InData%NacDragF) + call RegPackAlloc(RF, InData%NacDragM) + call RegPackAlloc(RF, InData%NacFi) + call RegPackAlloc(RF, InData%NacMi) + call RegPackAlloc(RF, InData%BlFI) + call RegPackAlloc(RF, InData%BlFA) + call RegPackAlloc(RF, InData%BlMA) + call RegPackAlloc(RF, InData%TwrFI) + call RegPackAlloc(RF, InData%TwrFA) + call RegPack(RF, allocated(InData%BladeRootLoad)) + if (allocated(InData%BladeRootLoad)) then + call RegPackBounds(RF, 1, lbound(InData%BladeRootLoad), ubound(InData%BladeRootLoad)) + LB(1:1) = lbound(InData%BladeRootLoad) + UB(1:1) = ubound(InData%BladeRootLoad) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%BladeMotion(i1)) + call MeshPack(RF, InData%BladeRootLoad(i1)) end do end if - call MeshPack(RF, InData%TFinMotion) - call RegPackAlloc(RF, InData%UserProp) + call RegPack(RF, allocated(InData%B_L_2_R_P)) + if (allocated(InData%B_L_2_R_P)) then + call RegPackBounds(RF, 1, lbound(InData%B_L_2_R_P), ubound(InData%B_L_2_R_P)) + LB(1:1) = lbound(InData%B_L_2_R_P) + UB(1:1) = ubound(InData%B_L_2_R_P) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%B_L_2_R_P(i1)) + end do + end if + call RegPack(RF, allocated(InData%BladeBuoyLoadPoint)) + if (allocated(InData%BladeBuoyLoadPoint)) then + call RegPackBounds(RF, 1, lbound(InData%BladeBuoyLoadPoint), ubound(InData%BladeBuoyLoadPoint)) + LB(1:1) = lbound(InData%BladeBuoyLoadPoint) + UB(1:1) = ubound(InData%BladeBuoyLoadPoint) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeBuoyLoadPoint(i1)) + end do + end if + call RegPack(RF, allocated(InData%BladeBuoyLoad)) + if (allocated(InData%BladeBuoyLoad)) then + call RegPackBounds(RF, 1, lbound(InData%BladeBuoyLoad), ubound(InData%BladeBuoyLoad)) + LB(1:1) = lbound(InData%BladeBuoyLoad) + UB(1:1) = ubound(InData%BladeBuoyLoad) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeBuoyLoad(i1)) + end do + end if + call RegPack(RF, allocated(InData%B_P_2_B_L)) + if (allocated(InData%B_P_2_B_L)) then + call RegPackBounds(RF, 1, lbound(InData%B_P_2_B_L), ubound(InData%B_P_2_B_L)) + LB(1:1) = lbound(InData%B_P_2_B_L) + UB(1:1) = ubound(InData%B_P_2_B_L) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%B_P_2_B_L(i1)) + end do + end if + call MeshPack(RF, InData%TwrBuoyLoadPoint) + call MeshPack(RF, InData%TwrBuoyLoad) + call NWTC_Library_PackMeshMapType(RF, InData%T_P_2_T_L) + call RegPack(RF, InData%FirstWarn_TowerStrike) + call RegPack(RF, InData%AvgDiskVel) + call RegPack(RF, InData%AvgDiskVelDist) + call RegPack(RF, InData%TFinAlpha) + call RegPack(RF, InData%TFinRe) + call RegPack(RF, InData%TFinVrel) + call RegPack(RF, InData%TFinVund_i) + call RegPack(RF, InData%TFinVind_i) + call RegPack(RF, InData%TFinVrel_i) + call RegPack(RF, InData%TFinSTV_i) + call RegPack(RF, InData%TFinF_i) + call RegPack(RF, InData%TFinM_i) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackRotInputType(RF, OutData) +subroutine AD_UnPackRotMiscVarType(RF, OutData) type(RegFile), intent(inout) :: RF - type(RotInputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackRotInputType' - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) + type(RotMiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotMiscVarType' + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call MeshUnpack(RF, OutData%NacelleMotion) ! NacelleMotion - call MeshUnpack(RF, OutData%TowerMotion) ! TowerMotion - call MeshUnpack(RF, OutData%HubMotion) ! HubMotion - if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call AD_UnpackRotContinuousStateType(RF, OutData%x_init) ! x_init + call AD_UnpackRotContinuousStateType(RF, OutData%x_perturb) ! x_perturb + call AD_UnpackRotContinuousStateType(RF, OutData%dxdt_lin) ! dxdt_lin + call AD_UnpackRotInputType(RF, OutData%u_perturb) ! u_perturb + call AD_UnpackRotOutputType(RF, OutData%y_lin) ! y_lin + call AD_UnpackRotConstraintStateType(RF, OutData%z_lin) ! z_lin + call AD_UnpackRotOtherStateType(RF, OutData%OtherState_init) ! OtherState_init + call AD_UnpackRotOtherStateType(RF, OutData%OtherState_jac) ! OtherState_jac + call BEMT_UnpackMisc(RF, OutData%BEMT) ! BEMT + call BEMT_UnpackOutput(RF, OutData%BEMT_y) ! BEMT_y + LB(1:1) = lbound(OutData%BEMT_u) + UB(1:1) = ubound(OutData%BEMT_u) + do i1 = LB(1), UB(1) + call BEMT_UnpackInput(RF, OutData%BEMT_u(i1)) ! BEMT_u + end do + call AA_UnpackMisc(RF, OutData%AA) ! AA + call AA_UnpackOutput(RF, OutData%AA_y) ! AA_y + call AA_UnpackInput(RF, OutData%AA_u) ! AA_u + call RegUnpackAlloc(RF, OutData%DisturbedInflow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SectAvgInflow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%orientationAnnulus); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%R_li); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%W_Twr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%X_Twr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Y_Twr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cant); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Toe); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrClrnc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Mx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%My); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Mz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vind_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%V_DiskAvg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%yaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%hub_theta_x_root); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%V_dot_x); if (RegCheckErr(RF, RoutineName)) return + call MeshUnpack(RF, OutData%HubLoad) ! HubLoad + if (allocated(OutData%B_L_2_H_P)) deallocate(OutData%B_L_2_H_P) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BladeRootMotion(LB(1):UB(1)),stat=stat) + allocate(OutData%B_L_2_H_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_H_P.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%B_L_2_H_P(i1)) ! B_L_2_H_P + end do + end if + call RegUnpackAlloc(RF, OutData%SigmaCavitCrit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SigmaCavit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CavitWarnSet); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrFB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrMB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HubFB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HubMB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NacFB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NacMB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NacDragF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NacDragM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NacFi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NacMi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlFI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlFA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlMA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrFI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrFA); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BladeRootLoad)) deallocate(OutData%BladeRootLoad) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeRootLoad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootLoad.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladeRootLoad(i1)) ! BladeRootLoad + end do + end if + if (allocated(OutData%B_L_2_R_P)) deallocate(OutData%B_L_2_R_P) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%B_L_2_R_P(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_R_P.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%BladeRootMotion(i1)) ! BladeRootMotion + call NWTC_Library_UnpackMeshMapType(RF, OutData%B_L_2_R_P(i1)) ! B_L_2_R_P end do end if - if (allocated(OutData%BladeMotion)) deallocate(OutData%BladeMotion) + if (allocated(OutData%BladeBuoyLoadPoint)) deallocate(OutData%BladeBuoyLoadPoint) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BladeMotion(LB(1):UB(1)),stat=stat) + allocate(OutData%BladeBuoyLoadPoint(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoadPoint.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%BladeMotion(i1)) ! BladeMotion + call MeshUnpack(RF, OutData%BladeBuoyLoadPoint(i1)) ! BladeBuoyLoadPoint end do end if - call MeshUnpack(RF, OutData%TFinMotion) ! TFinMotion - call RegUnpackAlloc(RF, OutData%UserProp); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) - type(AD_InputType), intent(inout) :: SrcInputData - type(AD_InputType), intent(inout) :: DstInputData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyInput' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcInputData%rotors)) then - LB(1:1) = lbound(SrcInputData%rotors) - UB(1:1) = ubound(SrcInputData%rotors) - if (.not. allocated(DstInputData%rotors)) then - allocate(DstInputData%rotors(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%rotors.', ErrStat, ErrMsg, RoutineName) - return - end if + if (allocated(OutData%BladeBuoyLoad)) deallocate(OutData%BladeBuoyLoad) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeBuoyLoad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoad.', RF%ErrStat, RF%ErrMsg, RoutineName) + return end if do i1 = LB(1), UB(1) - call AD_CopyRotInputType(SrcInputData%rotors(i1), DstInputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if -end subroutine - -subroutine AD_DestroyInput(InputData, ErrStat, ErrMsg) - type(AD_InputType), intent(inout) :: InputData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_DestroyInput' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(InputData%rotors)) then - LB(1:1) = lbound(InputData%rotors) - UB(1:1) = ubound(InputData%rotors) - do i1 = LB(1), UB(1) - call AD_DestroyRotInputType(InputData%rotors(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(InputData%rotors) - end if -end subroutine - -subroutine AD_PackInput(RF, Indata) - type(RegFile), intent(inout) :: RF - type(AD_InputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackInput' - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%rotors)) - if (allocated(InData%rotors)) then - call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) - LB(1:1) = lbound(InData%rotors) - UB(1:1) = ubound(InData%rotors) - do i1 = LB(1), UB(1) - call AD_PackRotInputType(RF, InData%rotors(i1)) + call MeshUnpack(RF, OutData%BladeBuoyLoad(i1)) ! BladeBuoyLoad end do end if - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AD_UnPackInput(RF, OutData) - type(RegFile), intent(inout) :: RF - type(AD_InputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackInput' - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%rotors)) deallocate(OutData%rotors) + if (allocated(OutData%B_P_2_B_L)) deallocate(OutData%B_P_2_B_L) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + allocate(OutData%B_P_2_B_L(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_P_2_B_L.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackRotInputType(RF, OutData%rotors(i1)) ! rotors + call NWTC_Library_UnpackMeshMapType(RF, OutData%B_P_2_B_L(i1)) ! B_P_2_B_L end do end if + call MeshUnpack(RF, OutData%TwrBuoyLoadPoint) ! TwrBuoyLoadPoint + call MeshUnpack(RF, OutData%TwrBuoyLoad) ! TwrBuoyLoad + call NWTC_Library_UnpackMeshMapType(RF, OutData%T_P_2_T_L) ! T_P_2_T_L + call RegUnpack(RF, OutData%FirstWarn_TowerStrike); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgDiskVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgDiskVelDist); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinAlpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinRe); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinVrel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinVund_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinVind_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinVrel_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinSTV_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinF_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinM_i); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_CopyRotOutputType(SrcRotOutputTypeData, DstRotOutputTypeData, CtrlCode, ErrStat, ErrMsg) - type(RotOutputType), intent(inout) :: SrcRotOutputTypeData - type(RotOutputType), intent(inout) :: DstRotOutputTypeData +subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(AD_MiscVarType), intent(inout) :: SrcMiscData + type(AD_MiscVarType), intent(inout) :: DstMiscData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyRotOutputType' + character(*), parameter :: RoutineName = 'AD_CopyMisc' ErrStat = ErrID_None ErrMsg = '' - call MeshCopy(SrcRotOutputTypeData%NacelleLoad, DstRotOutputTypeData%NacelleLoad, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcRotOutputTypeData%HubLoad, DstRotOutputTypeData%HubLoad, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcRotOutputTypeData%TowerLoad, DstRotOutputTypeData%TowerLoad, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcRotOutputTypeData%BladeLoad)) then - LB(1:1) = lbound(SrcRotOutputTypeData%BladeLoad) - UB(1:1) = ubound(SrcRotOutputTypeData%BladeLoad) - if (.not. allocated(DstRotOutputTypeData%BladeLoad)) then - allocate(DstRotOutputTypeData%BladeLoad(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%rotors)) then + LB(1:1) = lbound(SrcMiscData%rotors) + UB(1:1) = ubound(SrcMiscData%rotors) + if (.not. allocated(DstMiscData%rotors)) then + allocate(DstMiscData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotOutputTypeData%BladeLoad.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rotors.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MeshCopy(SrcRotOutputTypeData%BladeLoad(i1), DstRotOutputTypeData%BladeLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call AD_CopyRotMiscVarType(SrcMiscData%rotors(i1), DstMiscData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - call MeshCopy(SrcRotOutputTypeData%TFinLoad, DstRotOutputTypeData%TFinLoad, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcRotOutputTypeData%WriteOutput)) then - LB(1:1) = lbound(SrcRotOutputTypeData%WriteOutput) - UB(1:1) = ubound(SrcRotOutputTypeData%WriteOutput) - if (.not. allocated(DstRotOutputTypeData%WriteOutput)) then - allocate(DstRotOutputTypeData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotOutputTypeData%WriteOutput.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotOutputTypeData%WriteOutput = SrcRotOutputTypeData%WriteOutput - end if -end subroutine - -subroutine AD_DestroyRotOutputType(RotOutputTypeData, ErrStat, ErrMsg) - type(RotOutputType), intent(inout) :: RotOutputTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_DestroyRotOutputType' - ErrStat = ErrID_None - ErrMsg = '' - call MeshDestroy( RotOutputTypeData%NacelleLoad, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( RotOutputTypeData%HubLoad, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( RotOutputTypeData%TowerLoad, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(RotOutputTypeData%BladeLoad)) then - LB(1:1) = lbound(RotOutputTypeData%BladeLoad) - UB(1:1) = ubound(RotOutputTypeData%BladeLoad) - do i1 = LB(1), UB(1) - call MeshDestroy( RotOutputTypeData%BladeLoad(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(RotOutputTypeData%BladeLoad) - end if - call MeshDestroy( RotOutputTypeData%TFinLoad, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(RotOutputTypeData%WriteOutput)) then - deallocate(RotOutputTypeData%WriteOutput) - end if -end subroutine - -subroutine AD_PackRotOutputType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(RotOutputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackRotOutputType' - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - if (RF%ErrStat >= AbortErrLev) return - call MeshPack(RF, InData%NacelleLoad) - call MeshPack(RF, InData%HubLoad) - call MeshPack(RF, InData%TowerLoad) - call RegPack(RF, allocated(InData%BladeLoad)) - if (allocated(InData%BladeLoad)) then - call RegPackBounds(RF, 1, lbound(InData%BladeLoad), ubound(InData%BladeLoad)) - LB(1:1) = lbound(InData%BladeLoad) - UB(1:1) = ubound(InData%BladeLoad) - do i1 = LB(1), UB(1) - call MeshPack(RF, InData%BladeLoad(i1)) - end do - end if - call MeshPack(RF, InData%TFinLoad) - call RegPackAlloc(RF, InData%WriteOutput) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AD_UnPackRotOutputType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(RotOutputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackRotOutputType' - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call MeshUnpack(RF, OutData%NacelleLoad) ! NacelleLoad - call MeshUnpack(RF, OutData%HubLoad) ! HubLoad - call MeshUnpack(RF, OutData%TowerLoad) ! TowerLoad - if (allocated(OutData%BladeLoad)) deallocate(OutData%BladeLoad) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BladeLoad(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLoad.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + if (allocated(SrcMiscData%FVW_u)) then + LB(1:1) = lbound(SrcMiscData%FVW_u) + UB(1:1) = ubound(SrcMiscData%FVW_u) + if (.not. allocated(DstMiscData%FVW_u)) then + allocate(DstMiscData%FVW_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FVW_u.', ErrStat, ErrMsg, RoutineName) + return + end if end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%BladeLoad(i1)) ! BladeLoad + call FVW_CopyInput(SrcMiscData%FVW_u(i1), DstMiscData%FVW_u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end if - call MeshUnpack(RF, OutData%TFinLoad) ! TFinLoad - call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) - type(AD_OutputType), intent(inout) :: SrcOutputData - type(AD_OutputType), intent(inout) :: DstOutputData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyOutput' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcOutputData%rotors)) then - LB(1:1) = lbound(SrcOutputData%rotors) - UB(1:1) = ubound(SrcOutputData%rotors) - if (.not. allocated(DstOutputData%rotors)) then - allocate(DstOutputData%rotors(LB(1):UB(1)), stat=ErrStat2) + call FVW_CopyOutput(SrcMiscData%FVW_y, DstMiscData%FVW_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FVW_CopyMisc(SrcMiscData%FVW, DstMiscData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%WindPos)) then + LB(1:2) = lbound(SrcMiscData%WindPos) + UB(1:2) = ubound(SrcMiscData%WindPos) + if (.not. allocated(DstMiscData%WindPos)) then + allocate(DstMiscData%WindPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%rotors.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindPos = SrcMiscData%WindPos + end if + if (allocated(SrcMiscData%WindVel)) then + LB(1:2) = lbound(SrcMiscData%WindVel) + UB(1:2) = ubound(SrcMiscData%WindVel) + if (.not. allocated(DstMiscData%WindVel)) then + allocate(DstMiscData%WindVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindVel = SrcMiscData%WindVel + end if + if (allocated(SrcMiscData%WindAcc)) then + LB(1:2) = lbound(SrcMiscData%WindAcc) + UB(1:2) = ubound(SrcMiscData%WindAcc) + if (.not. allocated(DstMiscData%WindAcc)) then + allocate(DstMiscData%WindAcc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindAcc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindAcc = SrcMiscData%WindAcc + end if + call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%Inflow)) then + LB(1:1) = lbound(SrcMiscData%Inflow) + UB(1:1) = ubound(SrcMiscData%Inflow) + if (.not. allocated(DstMiscData%Inflow)) then + allocate(DstMiscData%Inflow(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Inflow.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call AD_CopyRotOutputType(SrcOutputData%rotors(i1), DstOutputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call AD_CopyInflowType(SrcMiscData%Inflow(i1), DstMiscData%Inflow(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if end subroutine -subroutine AD_DestroyOutput(OutputData, ErrStat, ErrMsg) - type(AD_OutputType), intent(inout) :: OutputData +subroutine AD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(AD_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_DestroyOutput' + character(*), parameter :: RoutineName = 'AD_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' - if (allocated(OutputData%rotors)) then - LB(1:1) = lbound(OutputData%rotors) - UB(1:1) = ubound(OutputData%rotors) + if (allocated(MiscData%rotors)) then + LB(1:1) = lbound(MiscData%rotors) + UB(1:1) = ubound(MiscData%rotors) do i1 = LB(1), UB(1) - call AD_DestroyRotOutputType(OutputData%rotors(i1), ErrStat2, ErrMsg2) + call AD_DestroyRotMiscVarType(MiscData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(OutputData%rotors) + deallocate(MiscData%rotors) + end if + if (allocated(MiscData%FVW_u)) then + LB(1:1) = lbound(MiscData%FVW_u) + UB(1:1) = ubound(MiscData%FVW_u) + do i1 = LB(1), UB(1) + call FVW_DestroyInput(MiscData%FVW_u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%FVW_u) + end if + call FVW_DestroyOutput(MiscData%FVW_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FVW_DestroyMisc(MiscData%FVW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%WindPos)) then + deallocate(MiscData%WindPos) + end if + if (allocated(MiscData%WindVel)) then + deallocate(MiscData%WindVel) + end if + if (allocated(MiscData%WindAcc)) then + deallocate(MiscData%WindAcc) + end if + call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%Inflow)) then + LB(1:1) = lbound(MiscData%Inflow) + UB(1:1) = ubound(MiscData%Inflow) + do i1 = LB(1), UB(1) + call AD_DestroyInflowType(MiscData%Inflow(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%Inflow) end if end subroutine -subroutine AD_PackOutput(RF, Indata) +subroutine AD_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF - type(AD_OutputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackOutput' - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) + type(AD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackMisc' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then @@ -6105,18 +6492,42 @@ subroutine AD_PackOutput(RF, Indata) LB(1:1) = lbound(InData%rotors) UB(1:1) = ubound(InData%rotors) do i1 = LB(1), UB(1) - call AD_PackRotOutputType(RF, InData%rotors(i1)) + call AD_PackRotMiscVarType(RF, InData%rotors(i1)) + end do + end if + call RegPack(RF, allocated(InData%FVW_u)) + if (allocated(InData%FVW_u)) then + call RegPackBounds(RF, 1, lbound(InData%FVW_u), ubound(InData%FVW_u)) + LB(1:1) = lbound(InData%FVW_u) + UB(1:1) = ubound(InData%FVW_u) + do i1 = LB(1), UB(1) + call FVW_PackInput(RF, InData%FVW_u(i1)) + end do + end if + call FVW_PackOutput(RF, InData%FVW_y) + call FVW_PackMisc(RF, InData%FVW) + call RegPackAlloc(RF, InData%WindPos) + call RegPackAlloc(RF, InData%WindVel) + call RegPackAlloc(RF, InData%WindAcc) + call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) + call RegPack(RF, allocated(InData%Inflow)) + if (allocated(InData%Inflow)) then + call RegPackBounds(RF, 1, lbound(InData%Inflow), ubound(InData%Inflow)) + LB(1:1) = lbound(InData%Inflow) + UB(1:1) = ubound(InData%Inflow) + do i1 = LB(1), UB(1) + call AD_PackInflowType(RF, InData%Inflow(i1)) end do end if if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackOutput(RF, OutData) +subroutine AD_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF - type(AD_OutputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackOutput' - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) + type(AD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackMisc' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -6130,7 +6541,39 @@ subroutine AD_UnPackOutput(RF, OutData) return end if do i1 = LB(1), UB(1) - call AD_UnpackRotOutputType(RF, OutData%rotors(i1)) ! rotors + call AD_UnpackRotMiscVarType(RF, OutData%rotors(i1)) ! rotors + end do + end if + if (allocated(OutData%FVW_u)) deallocate(OutData%FVW_u) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%FVW_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FVW_u.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackInput(RF, OutData%FVW_u(i1)) ! FVW_u + end do + end if + call FVW_UnpackOutput(RF, OutData%FVW_y) ! FVW_y + call FVW_UnpackMisc(RF, OutData%FVW) ! FVW + call RegUnpackAlloc(RF, OutData%WindPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindAcc); if (RegCheckErr(RF, RoutineName)) return + call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m + if (allocated(OutData%Inflow)) deallocate(OutData%Inflow) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Inflow(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Inflow.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackInflowType(RF, OutData%Inflow(i1)) ! Inflow end do end if end subroutine @@ -6832,5 +7275,403 @@ SUBROUTINE AD_InflowType_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, END DO END IF ! check if allocated END SUBROUTINE + +function AD_InputMeshPointer(u, DL) result(Mesh) + type(RotInputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (AD_u_NacelleMotion) + Mesh => u%NacelleMotion + case (AD_u_TowerMotion) + Mesh => u%TowerMotion + case (AD_u_HubMotion) + Mesh => u%HubMotion + case (AD_u_BladeRootMotion) + Mesh => u%BladeRootMotion(DL%i1) + case (AD_u_BladeMotion) + Mesh => u%BladeMotion(DL%i1) + case (AD_u_TFinMotion) + Mesh => u%TFinMotion + end select +end function + +function AD_OutputMeshPointer(y, DL) result(Mesh) + type(RotOutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (AD_y_NacelleLoad) + Mesh => y%NacelleLoad + case (AD_y_HubLoad) + Mesh => y%HubLoad + case (AD_y_TowerLoad) + Mesh => y%TowerLoad + case (AD_y_BladeLoad) + Mesh => y%BladeLoad(DL%i1) + case (AD_y_TFinLoad) + Mesh => y%TFinLoad + end select +end function + +subroutine AD_VarsPackContState(Vars, x, ValAry) + type(RotContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call AD_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine AD_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(RotContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AD_x_BEMT_UA_element_x) + VarVals = x%BEMT%UA%element(DL%i1, DL%i2)%x(V%iLB:V%iUB) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind) + VarVals = x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind(V%iLB:V%iUB) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind_1) + VarVals = x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iLB:V%iUB) ! Rank 1 Array + case (AD_x_BEMT_V_w) + VarVals = x%BEMT%V_w(V%iLB:V%iUB) ! Rank 1 Array + case (AD_x_AA_DummyContState) + VarVals(1) = x%AA%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AD_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(RotContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call AD_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine AD_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(RotContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AD_x_BEMT_UA_element_x) + x%BEMT%UA%element(DL%i1, DL%i2)%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind) + x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind_1) + x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (AD_x_BEMT_V_w) + x%BEMT%V_w(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (AD_x_AA_DummyContState) + x%AA%DummyContState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function AD_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AD_x_BEMT_UA_element_x) + Name = "x%BEMT%UA%element("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")%x" + case (AD_x_BEMT_DBEMT_element_vind) + Name = "x%BEMT%DBEMT%element("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")%vind" + case (AD_x_BEMT_DBEMT_element_vind_1) + Name = "x%BEMT%DBEMT%element("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")%vind_1" + case (AD_x_BEMT_V_w) + Name = "x%BEMT%V_w" + case (AD_x_AA_DummyContState) + Name = "x%AA%DummyContState" + case default + Name = "Unknown Field" + end select +end function + +subroutine AD_VarsPackContStateDeriv(Vars, x, ValAry) + type(RotContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call AD_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine AD_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(RotContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AD_x_BEMT_UA_element_x) + VarVals = x%BEMT%UA%element(DL%i1, DL%i2)%x(V%iLB:V%iUB) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind) + VarVals = x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind(V%iLB:V%iUB) ! Rank 1 Array + case (AD_x_BEMT_DBEMT_element_vind_1) + VarVals = x%BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iLB:V%iUB) ! Rank 1 Array + case (AD_x_BEMT_V_w) + VarVals = x%BEMT%V_w(V%iLB:V%iUB) ! Rank 1 Array + case (AD_x_AA_DummyContState) + VarVals(1) = x%AA%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AD_VarsPackConstrState(Vars, z, ValAry) + type(RotConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call AD_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine AD_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(RotConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AD_z_BEMT_phi) + VarVals = z%BEMT%phi(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (AD_z_AA_DummyConstrState) + VarVals(1) = z%AA%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AD_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(RotConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call AD_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine AD_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(RotConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AD_z_BEMT_phi) + z%BEMT%phi(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (AD_z_AA_DummyConstrState) + z%AA%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function AD_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AD_z_BEMT_phi) + Name = "z%BEMT%phi" + case (AD_z_AA_DummyConstrState) + Name = "z%AA%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine AD_VarsPackInput(Vars, u, ValAry) + type(RotInputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call AD_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine AD_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(RotInputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AD_u_NacelleMotion) + call MV_PackMesh(V, u%NacelleMotion, ValAry) ! Mesh + case (AD_u_TowerMotion) + call MV_PackMesh(V, u%TowerMotion, ValAry) ! Mesh + case (AD_u_HubMotion) + call MV_PackMesh(V, u%HubMotion, ValAry) ! Mesh + case (AD_u_BladeRootMotion) + call MV_PackMesh(V, u%BladeRootMotion(DL%i1), ValAry) ! Mesh + case (AD_u_BladeMotion) + call MV_PackMesh(V, u%BladeMotion(DL%i1), ValAry) ! Mesh + case (AD_u_TFinMotion) + call MV_PackMesh(V, u%TFinMotion, ValAry) ! Mesh + case (AD_u_UserProp) + VarVals = u%UserProp(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AD_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(RotInputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call AD_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine AD_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(RotInputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AD_u_NacelleMotion) + call MV_UnpackMesh(V, ValAry, u%NacelleMotion) ! Mesh + case (AD_u_TowerMotion) + call MV_UnpackMesh(V, ValAry, u%TowerMotion) ! Mesh + case (AD_u_HubMotion) + call MV_UnpackMesh(V, ValAry, u%HubMotion) ! Mesh + case (AD_u_BladeRootMotion) + call MV_UnpackMesh(V, ValAry, u%BladeRootMotion(DL%i1)) ! Mesh + case (AD_u_BladeMotion) + call MV_UnpackMesh(V, ValAry, u%BladeMotion(DL%i1)) ! Mesh + case (AD_u_TFinMotion) + call MV_UnpackMesh(V, ValAry, u%TFinMotion) ! Mesh + case (AD_u_UserProp) + u%UserProp(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + +function AD_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AD_u_NacelleMotion) + Name = "u%NacelleMotion" + case (AD_u_TowerMotion) + Name = "u%TowerMotion" + case (AD_u_HubMotion) + Name = "u%HubMotion" + case (AD_u_BladeRootMotion) + Name = "u%BladeRootMotion("//trim(Num2LStr(DL%i1))//")" + case (AD_u_BladeMotion) + Name = "u%BladeMotion("//trim(Num2LStr(DL%i1))//")" + case (AD_u_TFinMotion) + Name = "u%TFinMotion" + case (AD_u_UserProp) + Name = "u%UserProp" + case default + Name = "Unknown Field" + end select +end function + +subroutine AD_VarsPackOutput(Vars, y, ValAry) + type(RotOutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call AD_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine AD_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(RotOutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AD_y_NacelleLoad) + call MV_PackMesh(V, y%NacelleLoad, ValAry) ! Mesh + case (AD_y_HubLoad) + call MV_PackMesh(V, y%HubLoad, ValAry) ! Mesh + case (AD_y_TowerLoad) + call MV_PackMesh(V, y%TowerLoad, ValAry) ! Mesh + case (AD_y_BladeLoad) + call MV_PackMesh(V, y%BladeLoad(DL%i1), ValAry) ! Mesh + case (AD_y_TFinLoad) + call MV_PackMesh(V, y%TFinLoad, ValAry) ! Mesh + case (AD_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AD_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(RotOutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call AD_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine AD_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(RotOutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AD_y_NacelleLoad) + call MV_UnpackMesh(V, ValAry, y%NacelleLoad) ! Mesh + case (AD_y_HubLoad) + call MV_UnpackMesh(V, ValAry, y%HubLoad) ! Mesh + case (AD_y_TowerLoad) + call MV_UnpackMesh(V, ValAry, y%TowerLoad) ! Mesh + case (AD_y_BladeLoad) + call MV_UnpackMesh(V, ValAry, y%BladeLoad(DL%i1)) ! Mesh + case (AD_y_TFinLoad) + call MV_UnpackMesh(V, ValAry, y%TFinLoad) ! Mesh + case (AD_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function AD_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AD_y_NacelleLoad) + Name = "y%NacelleLoad" + case (AD_y_HubLoad) + Name = "y%HubLoad" + case (AD_y_TowerLoad) + Name = "y%TowerLoad" + case (AD_y_BladeLoad) + Name = "y%BladeLoad("//trim(Num2LStr(DL%i1))//")" + case (AD_y_TFinLoad) + Name = "y%TFinLoad" + case (AD_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE AeroDyn_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index 3ee973c9d5..ae02f958b3 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -33,18 +33,18 @@ MODULE AirfoilInfo_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: AFITable_1 = 1 ! 1D interpolation on AoA (first table only) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AFITable_2Re = 2 ! 2D interpolation on AoA and Re [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AFITable_2User = 3 ! 2D interpolation on AoA and UserProp [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_None = 0 ! Steady aerodynamics, using the same angle of attack convention as UA [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Baseline = 1 ! UAMod = 1 [Baseline model (Original)] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Gonzalez = 2 ! UAMod = 2 [Gonzalez's variant (changes in Cn,Cc,Cm)] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_MinnemaPierce = 3 ! Minnema/Pierce variant (changes in Cc and Cm) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_HGM = 4 ! continuous variant of HGM (Hansen) model [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_HGMV = 5 ! continuous variant of HGM (Hansen) model with vortex modifications [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Oye = 6 ! Stieg Oye dynamic stall model [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_BV = 7 ! Boeing-Vertol dynamic stall model (e.g. used in CACTUS) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_HGMV360 = 8 ! continuous variant of HGM (Hansen) model with vortex modifications modified for 360-deg [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AFITable_1 = 1 ! 1D interpolation on AoA (first table only) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AFITable_2Re = 2 ! 2D interpolation on AoA and Re [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AFITable_2User = 3 ! 2D interpolation on AoA and UserProp [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_None = 0 ! Steady aerodynamics, using the same angle of attack convention as UA [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Baseline = 1 ! UAMod = 1 [Baseline model (Original)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Gonzalez = 2 ! UAMod = 2 [Gonzalez's variant (changes in Cn,Cc,Cm)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_MinnemaPierce = 3 ! Minnema/Pierce variant (changes in Cc and Cm) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_HGM = 4 ! continuous variant of HGM (Hansen) model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_HGMV = 5 ! continuous variant of HGM (Hansen) model with vortex modifications [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Oye = 6 ! Stieg Oye dynamic stall model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_BV = 7 ! Boeing-Vertol dynamic stall model (e.g. used in CACTUS) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_HGMV360 = 8 ! continuous variant of HGM (Hansen) model with vortex modifications modified for 360-deg [-] ! ========= AFI_UA_BL_Type ======= TYPE, PUBLIC :: AFI_UA_BL_Type REAL(ReKi) :: alpha0 = 0.0_ReKi !< Angle of attack for zero lift (also used in HGM) [input in degrees; stored as radians] @@ -204,7 +204,20 @@ MODULE AirfoilInfo_Types REAL(ReKi) :: FullyAttached = 0. !< fully attached cn or cl polar function (used for UA models) [-] END TYPE AFI_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: AFI_u_AoA = 1 ! AFI%AoA + integer(IntKi), public, parameter :: AFI_u_UserProp = 2 ! AFI%UserProp + integer(IntKi), public, parameter :: AFI_u_Re = 3 ! AFI%Re + integer(IntKi), public, parameter :: AFI_y_Cl = 4 ! AFI%Cl + integer(IntKi), public, parameter :: AFI_y_Cd = 5 ! AFI%Cd + integer(IntKi), public, parameter :: AFI_y_Cm = 6 ! AFI%Cm + integer(IntKi), public, parameter :: AFI_y_Cpmin = 7 ! AFI%Cpmin + integer(IntKi), public, parameter :: AFI_y_Cd0 = 8 ! AFI%Cd0 + integer(IntKi), public, parameter :: AFI_y_Cm0 = 9 ! AFI%Cm0 + integer(IntKi), public, parameter :: AFI_y_f_st = 10 ! AFI%f_st + integer(IntKi), public, parameter :: AFI_y_FullySeparate = 11 ! AFI%FullySeparate + integer(IntKi), public, parameter :: AFI_y_FullyAttached = 12 ! AFI%FullyAttached + +contains subroutine AFI_CopyUA_BL_Type(SrcUA_BL_TypeData, DstUA_BL_TypeData, CtrlCode, ErrStat, ErrMsg) type(AFI_UA_BL_Type), intent(in) :: SrcUA_BL_TypeData @@ -1438,5 +1451,199 @@ SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat CALL Angles_ExtrapInterp( u1%alphaBreakLower, u2%alphaBreakLower, u3%alphaBreakLower, tin, u_out%alphaBreakLower, tin_out ) u_out%CnBreakLower = a1*u1%CnBreakLower + a2*u2%CnBreakLower + a3*u3%CnBreakLower END SUBROUTINE + +function AFI_InputMeshPointer(u, DL) result(Mesh) + type(AFI_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +function AFI_OutputMeshPointer(y, DL) result(Mesh) + type(AFI_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +subroutine AFI_VarsPackInput(Vars, u, ValAry) + type(AFI_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call AFI_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine AFI_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(AFI_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AFI_u_AoA) + VarVals(1) = u%AoA ! Scalar + case (AFI_u_UserProp) + VarVals(1) = u%UserProp ! Scalar + case (AFI_u_Re) + VarVals(1) = u%Re ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AFI_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AFI_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call AFI_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine AFI_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(AFI_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AFI_u_AoA) + u%AoA = VarVals(1) ! Scalar + case (AFI_u_UserProp) + u%UserProp = VarVals(1) ! Scalar + case (AFI_u_Re) + u%Re = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function AFI_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AFI_u_AoA) + Name = "u%AoA" + case (AFI_u_UserProp) + Name = "u%UserProp" + case (AFI_u_Re) + Name = "u%Re" + case default + Name = "Unknown Field" + end select +end function + +subroutine AFI_VarsPackOutput(Vars, y, ValAry) + type(AFI_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call AFI_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine AFI_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(AFI_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AFI_y_Cl) + VarVals(1) = y%Cl ! Scalar + case (AFI_y_Cd) + VarVals(1) = y%Cd ! Scalar + case (AFI_y_Cm) + VarVals(1) = y%Cm ! Scalar + case (AFI_y_Cpmin) + VarVals(1) = y%Cpmin ! Scalar + case (AFI_y_Cd0) + VarVals(1) = y%Cd0 ! Scalar + case (AFI_y_Cm0) + VarVals(1) = y%Cm0 ! Scalar + case (AFI_y_f_st) + VarVals(1) = y%f_st ! Scalar + case (AFI_y_FullySeparate) + VarVals(1) = y%FullySeparate ! Scalar + case (AFI_y_FullyAttached) + VarVals(1) = y%FullyAttached ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AFI_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AFI_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call AFI_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine AFI_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(AFI_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AFI_y_Cl) + y%Cl = VarVals(1) ! Scalar + case (AFI_y_Cd) + y%Cd = VarVals(1) ! Scalar + case (AFI_y_Cm) + y%Cm = VarVals(1) ! Scalar + case (AFI_y_Cpmin) + y%Cpmin = VarVals(1) ! Scalar + case (AFI_y_Cd0) + y%Cd0 = VarVals(1) ! Scalar + case (AFI_y_Cm0) + y%Cm0 = VarVals(1) ! Scalar + case (AFI_y_f_st) + y%f_st = VarVals(1) ! Scalar + case (AFI_y_FullySeparate) + y%FullySeparate = VarVals(1) ! Scalar + case (AFI_y_FullyAttached) + y%FullyAttached = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function AFI_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AFI_y_Cl) + Name = "y%Cl" + case (AFI_y_Cd) + Name = "y%Cd" + case (AFI_y_Cm) + Name = "y%Cm" + case (AFI_y_Cpmin) + Name = "y%Cpmin" + case (AFI_y_Cd0) + Name = "y%Cd0" + case (AFI_y_Cm0) + Name = "y%Cm0" + case (AFI_y_f_st) + Name = "y%f_st" + case (AFI_y_FullySeparate) + Name = "y%FullySeparate" + case (AFI_y_FullyAttached) + Name = "y%FullyAttached" + case default + Name = "Unknown Field" + end select +end function + END MODULE AirfoilInfo_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index 88dfc7823e..000671e07f 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -36,14 +36,14 @@ MODULE BEMT_Types USE DBEMT_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: Skew_Mod_Orthogonal = -1 ! Inflow orthogonal to rotor [-] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Skew_Mod_None = 0 ! No skew model [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Skew_Mod_Active = 1 ! Skew model active [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Skew_Mod_PittPeters_Cont = 4 ! Pitt/Peters continuous formulation [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SkewRedistrMod_None = 0 ! No redistribution [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SkewRedistrMod_PittPeters = 1 ! Pitt/Peters/Glauert redistribution [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BEMMod_2D = 1 ! 2D BEM assuming Cx, Cy, phi, L, D are in the same plane [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BEMMod_3D = 2 ! 3D BEM assuming a momentum balance system, and an airfoil system [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Skew_Mod_Orthogonal = -1 ! Inflow orthogonal to rotor [-] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Skew_Mod_None = 0 ! No skew model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Skew_Mod_Active = 1 ! Skew model active [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Skew_Mod_PittPeters_Cont = 4 ! Pitt/Peters continuous formulation [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SkewRedistrMod_None = 0 ! No redistribution [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SkewRedistrMod_PittPeters = 1 ! Pitt/Peters/Glauert redistribution [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BEMMod_2D = 1 ! 2D BEM assuming Cx, Cy, phi, L, D are in the same plane [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BEMMod_3D = 2 ! 3D BEM assuming a momentum balance system, and an airfoil system [-] ! ========= BEMT_InitInputType ======= TYPE, PUBLIC :: BEMT_InitInputType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: chord !< Chord length at node [m] @@ -226,7 +226,54 @@ MODULE BEMT_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Cpmin !< min Cpressure [-] END TYPE BEMT_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: BEMT_x_UA_element_x = 1 ! BEMT%UA%element(DL%i1, DL%i2)%x + integer(IntKi), public, parameter :: BEMT_x_DBEMT_element_vind = 2 ! BEMT%DBEMT%element(DL%i1, DL%i2)%vind + integer(IntKi), public, parameter :: BEMT_x_DBEMT_element_vind_1 = 3 ! BEMT%DBEMT%element(DL%i1, DL%i2)%vind_1 + integer(IntKi), public, parameter :: BEMT_x_V_w = 4 ! BEMT%V_w + integer(IntKi), public, parameter :: BEMT_z_phi = 5 ! BEMT%phi + integer(IntKi), public, parameter :: BEMT_u_theta = 6 ! BEMT%theta + integer(IntKi), public, parameter :: BEMT_u_chi0 = 7 ! BEMT%chi0 + integer(IntKi), public, parameter :: BEMT_u_psiSkewOffset = 8 ! BEMT%psiSkewOffset + integer(IntKi), public, parameter :: BEMT_u_psi_s = 9 ! BEMT%psi_s + integer(IntKi), public, parameter :: BEMT_u_omega = 10 ! BEMT%omega + integer(IntKi), public, parameter :: BEMT_u_TSR = 11 ! BEMT%TSR + integer(IntKi), public, parameter :: BEMT_u_Vx = 12 ! BEMT%Vx + integer(IntKi), public, parameter :: BEMT_u_Vy = 13 ! BEMT%Vy + integer(IntKi), public, parameter :: BEMT_u_Vz = 14 ! BEMT%Vz + integer(IntKi), public, parameter :: BEMT_u_omega_z = 15 ! BEMT%omega_z + integer(IntKi), public, parameter :: BEMT_u_xVelCorr = 16 ! BEMT%xVelCorr + integer(IntKi), public, parameter :: BEMT_u_rLocal = 17 ! BEMT%rLocal + integer(IntKi), public, parameter :: BEMT_u_Un_disk = 18 ! BEMT%Un_disk + integer(IntKi), public, parameter :: BEMT_u_V0 = 19 ! BEMT%V0 + integer(IntKi), public, parameter :: BEMT_u_x_hat_disk = 20 ! BEMT%x_hat_disk + integer(IntKi), public, parameter :: BEMT_u_UserProp = 21 ! BEMT%UserProp + integer(IntKi), public, parameter :: BEMT_u_CantAngle = 22 ! BEMT%CantAngle + integer(IntKi), public, parameter :: BEMT_u_drdz = 23 ! BEMT%drdz + integer(IntKi), public, parameter :: BEMT_u_toeAngle = 24 ! BEMT%toeAngle + integer(IntKi), public, parameter :: BEMT_y_Vrel = 25 ! BEMT%Vrel + integer(IntKi), public, parameter :: BEMT_y_phi = 26 ! BEMT%phi + integer(IntKi), public, parameter :: BEMT_y_axInduction = 27 ! BEMT%axInduction + integer(IntKi), public, parameter :: BEMT_y_tanInduction = 28 ! BEMT%tanInduction + integer(IntKi), public, parameter :: BEMT_y_axInduction_qs = 29 ! BEMT%axInduction_qs + integer(IntKi), public, parameter :: BEMT_y_tanInduction_qs = 30 ! BEMT%tanInduction_qs + integer(IntKi), public, parameter :: BEMT_y_k = 31 ! BEMT%k + integer(IntKi), public, parameter :: BEMT_y_k_p = 32 ! BEMT%k_p + integer(IntKi), public, parameter :: BEMT_y_F = 33 ! BEMT%F + integer(IntKi), public, parameter :: BEMT_y_Re = 34 ! BEMT%Re + integer(IntKi), public, parameter :: BEMT_y_AOA = 35 ! BEMT%AOA + integer(IntKi), public, parameter :: BEMT_y_Cx = 36 ! BEMT%Cx + integer(IntKi), public, parameter :: BEMT_y_Cy = 37 ! BEMT%Cy + integer(IntKi), public, parameter :: BEMT_y_Cz = 38 ! BEMT%Cz + integer(IntKi), public, parameter :: BEMT_y_Cmx = 39 ! BEMT%Cmx + integer(IntKi), public, parameter :: BEMT_y_Cmy = 40 ! BEMT%Cmy + integer(IntKi), public, parameter :: BEMT_y_Cmz = 41 ! BEMT%Cmz + integer(IntKi), public, parameter :: BEMT_y_Cm = 42 ! BEMT%Cm + integer(IntKi), public, parameter :: BEMT_y_Cl = 43 ! BEMT%Cl + integer(IntKi), public, parameter :: BEMT_y_Cd = 44 ! BEMT%Cd + integer(IntKi), public, parameter :: BEMT_y_chi = 45 ! BEMT%chi + integer(IntKi), public, parameter :: BEMT_y_Cpmin = 46 ! BEMT%Cpmin + +contains subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(BEMT_InitInputType), intent(in) :: SrcInitInputData @@ -2615,5 +2662,535 @@ SUBROUTINE BEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E y_out%Cpmin = a1*y1%Cpmin + a2*y2%Cpmin + a3*y3%Cpmin END IF ! check if allocated END SUBROUTINE + +function BEMT_InputMeshPointer(u, DL) result(Mesh) + type(BEMT_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +function BEMT_OutputMeshPointer(y, DL) result(Mesh) + type(BEMT_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +subroutine BEMT_VarsPackContState(Vars, x, ValAry) + type(BEMT_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call BEMT_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine BEMT_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(BEMT_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BEMT_x_UA_element_x) + VarVals = x%UA%element(DL%i1, DL%i2)%x(V%iLB:V%iUB) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind) + VarVals = x%DBEMT%element(DL%i1, DL%i2)%vind(V%iLB:V%iUB) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind_1) + VarVals = x%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iLB:V%iUB) ! Rank 1 Array + case (BEMT_x_V_w) + VarVals = x%V_w(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine BEMT_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(BEMT_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call BEMT_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine BEMT_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(BEMT_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BEMT_x_UA_element_x) + x%UA%element(DL%i1, DL%i2)%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind) + x%DBEMT%element(DL%i1, DL%i2)%vind(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind_1) + x%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (BEMT_x_V_w) + x%V_w(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function BEMT_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (BEMT_x_UA_element_x) + Name = "x%UA%element("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")%x" + case (BEMT_x_DBEMT_element_vind) + Name = "x%DBEMT%element("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")%vind" + case (BEMT_x_DBEMT_element_vind_1) + Name = "x%DBEMT%element("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")%vind_1" + case (BEMT_x_V_w) + Name = "x%V_w" + case default + Name = "Unknown Field" + end select +end function + +subroutine BEMT_VarsPackContStateDeriv(Vars, x, ValAry) + type(BEMT_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call BEMT_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine BEMT_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(BEMT_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BEMT_x_UA_element_x) + VarVals = x%UA%element(DL%i1, DL%i2)%x(V%iLB:V%iUB) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind) + VarVals = x%DBEMT%element(DL%i1, DL%i2)%vind(V%iLB:V%iUB) ! Rank 1 Array + case (BEMT_x_DBEMT_element_vind_1) + VarVals = x%DBEMT%element(DL%i1, DL%i2)%vind_1(V%iLB:V%iUB) ! Rank 1 Array + case (BEMT_x_V_w) + VarVals = x%V_w(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine BEMT_VarsPackConstrState(Vars, z, ValAry) + type(BEMT_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call BEMT_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine BEMT_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(BEMT_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BEMT_z_phi) + VarVals = z%phi(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine BEMT_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(BEMT_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call BEMT_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine BEMT_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(BEMT_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BEMT_z_phi) + z%phi(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + +function BEMT_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (BEMT_z_phi) + Name = "z%phi" + case default + Name = "Unknown Field" + end select +end function + +subroutine BEMT_VarsPackInput(Vars, u, ValAry) + type(BEMT_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call BEMT_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine BEMT_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(BEMT_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BEMT_u_theta) + VarVals = u%theta(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_u_chi0) + VarVals(1) = u%chi0 ! Scalar + case (BEMT_u_psiSkewOffset) + VarVals(1) = u%psiSkewOffset ! Scalar + case (BEMT_u_psi_s) + VarVals = u%psi_s(V%iLB:V%iUB) ! Rank 1 Array + case (BEMT_u_omega) + VarVals(1) = u%omega ! Scalar + case (BEMT_u_TSR) + VarVals(1) = u%TSR ! Scalar + case (BEMT_u_Vx) + VarVals = u%Vx(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_u_Vy) + VarVals = u%Vy(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_u_Vz) + VarVals = u%Vz(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_u_omega_z) + VarVals = u%omega_z(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_u_xVelCorr) + VarVals = u%xVelCorr(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_u_rLocal) + VarVals = u%rLocal(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_u_Un_disk) + VarVals(1) = u%Un_disk ! Scalar + case (BEMT_u_V0) + VarVals = u%V0(V%iLB:V%iUB) ! Rank 1 Array + case (BEMT_u_x_hat_disk) + VarVals = u%x_hat_disk(V%iLB:V%iUB) ! Rank 1 Array + case (BEMT_u_UserProp) + VarVals = u%UserProp(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_u_CantAngle) + VarVals = u%CantAngle(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_u_drdz) + VarVals = u%drdz(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_u_toeAngle) + VarVals = u%toeAngle(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine BEMT_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(BEMT_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call BEMT_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine BEMT_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(BEMT_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BEMT_u_theta) + u%theta(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_u_chi0) + u%chi0 = VarVals(1) ! Scalar + case (BEMT_u_psiSkewOffset) + u%psiSkewOffset = VarVals(1) ! Scalar + case (BEMT_u_psi_s) + u%psi_s(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (BEMT_u_omega) + u%omega = VarVals(1) ! Scalar + case (BEMT_u_TSR) + u%TSR = VarVals(1) ! Scalar + case (BEMT_u_Vx) + u%Vx(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_u_Vy) + u%Vy(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_u_Vz) + u%Vz(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_u_omega_z) + u%omega_z(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_u_xVelCorr) + u%xVelCorr(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_u_rLocal) + u%rLocal(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_u_Un_disk) + u%Un_disk = VarVals(1) ! Scalar + case (BEMT_u_V0) + u%V0(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (BEMT_u_x_hat_disk) + u%x_hat_disk(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (BEMT_u_UserProp) + u%UserProp(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_u_CantAngle) + u%CantAngle(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_u_drdz) + u%drdz(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_u_toeAngle) + u%toeAngle(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + +function BEMT_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (BEMT_u_theta) + Name = "u%theta" + case (BEMT_u_chi0) + Name = "u%chi0" + case (BEMT_u_psiSkewOffset) + Name = "u%psiSkewOffset" + case (BEMT_u_psi_s) + Name = "u%psi_s" + case (BEMT_u_omega) + Name = "u%omega" + case (BEMT_u_TSR) + Name = "u%TSR" + case (BEMT_u_Vx) + Name = "u%Vx" + case (BEMT_u_Vy) + Name = "u%Vy" + case (BEMT_u_Vz) + Name = "u%Vz" + case (BEMT_u_omega_z) + Name = "u%omega_z" + case (BEMT_u_xVelCorr) + Name = "u%xVelCorr" + case (BEMT_u_rLocal) + Name = "u%rLocal" + case (BEMT_u_Un_disk) + Name = "u%Un_disk" + case (BEMT_u_V0) + Name = "u%V0" + case (BEMT_u_x_hat_disk) + Name = "u%x_hat_disk" + case (BEMT_u_UserProp) + Name = "u%UserProp" + case (BEMT_u_CantAngle) + Name = "u%CantAngle" + case (BEMT_u_drdz) + Name = "u%drdz" + case (BEMT_u_toeAngle) + Name = "u%toeAngle" + case default + Name = "Unknown Field" + end select +end function + +subroutine BEMT_VarsPackOutput(Vars, y, ValAry) + type(BEMT_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call BEMT_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine BEMT_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(BEMT_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BEMT_y_Vrel) + VarVals = y%Vrel(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_phi) + VarVals = y%phi(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_axInduction) + VarVals = y%axInduction(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_tanInduction) + VarVals = y%tanInduction(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_axInduction_qs) + VarVals = y%axInduction_qs(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_tanInduction_qs) + VarVals = y%tanInduction_qs(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_k) + VarVals = y%k(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_k_p) + VarVals = y%k_p(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_F) + VarVals = y%F(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_Re) + VarVals = y%Re(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_AOA) + VarVals = y%AOA(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_Cx) + VarVals = y%Cx(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_Cy) + VarVals = y%Cy(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_Cz) + VarVals = y%Cz(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_Cmx) + VarVals = y%Cmx(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_Cmy) + VarVals = y%Cmy(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_Cmz) + VarVals = y%Cmz(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_Cm) + VarVals = y%Cm(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_Cl) + VarVals = y%Cl(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_Cd) + VarVals = y%Cd(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_chi) + VarVals = y%chi(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BEMT_y_Cpmin) + VarVals = y%Cpmin(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine BEMT_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(BEMT_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call BEMT_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine BEMT_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(BEMT_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BEMT_y_Vrel) + y%Vrel(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_phi) + y%phi(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_axInduction) + y%axInduction(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_tanInduction) + y%tanInduction(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_axInduction_qs) + y%axInduction_qs(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_tanInduction_qs) + y%tanInduction_qs(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_k) + y%k(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_k_p) + y%k_p(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_F) + y%F(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_Re) + y%Re(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_AOA) + y%AOA(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_Cx) + y%Cx(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_Cy) + y%Cy(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_Cz) + y%Cz(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_Cmx) + y%Cmx(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_Cmy) + y%Cmy(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_Cmz) + y%Cmz(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_Cm) + y%Cm(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_Cl) + y%Cl(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_Cd) + y%Cd(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_chi) + y%chi(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (BEMT_y_Cpmin) + y%Cpmin(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + +function BEMT_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (BEMT_y_Vrel) + Name = "y%Vrel" + case (BEMT_y_phi) + Name = "y%phi" + case (BEMT_y_axInduction) + Name = "y%axInduction" + case (BEMT_y_tanInduction) + Name = "y%tanInduction" + case (BEMT_y_axInduction_qs) + Name = "y%axInduction_qs" + case (BEMT_y_tanInduction_qs) + Name = "y%tanInduction_qs" + case (BEMT_y_k) + Name = "y%k" + case (BEMT_y_k_p) + Name = "y%k_p" + case (BEMT_y_F) + Name = "y%F" + case (BEMT_y_Re) + Name = "y%Re" + case (BEMT_y_AOA) + Name = "y%AOA" + case (BEMT_y_Cx) + Name = "y%Cx" + case (BEMT_y_Cy) + Name = "y%Cy" + case (BEMT_y_Cz) + Name = "y%Cz" + case (BEMT_y_Cmx) + Name = "y%Cmx" + case (BEMT_y_Cmy) + Name = "y%Cmy" + case (BEMT_y_Cmz) + Name = "y%Cmz" + case (BEMT_y_Cm) + Name = "y%Cm" + case (BEMT_y_Cl) + Name = "y%Cl" + case (BEMT_y_Cd) + Name = "y%Cd" + case (BEMT_y_chi) + Name = "y%chi" + case (BEMT_y_Cpmin) + Name = "y%Cpmin" + case default + Name = "Unknown Field" + end select +end function + END MODULE BEMT_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index 967e43cf06..6f50584c04 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -33,11 +33,11 @@ MODULE DBEMT_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_frozen = -1 ! use frozen-wake for linearization (not DBEMT) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_none = 0 ! use BEMT instead (not DBEMT) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_tauConst = 1 ! use constant tau1 [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_tauVaries = 2 ! use time-dependent tau1 [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_cont_tauConst = 3 ! use continuous formulation with constant tau1 [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_frozen = -1 ! use frozen-wake for linearization (not DBEMT) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_none = 0 ! use BEMT instead (not DBEMT) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_tauConst = 1 ! use constant tau1 [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_tauVaries = 2 ! use time-dependent tau1 [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_cont_tauConst = 3 ! use continuous formulation with constant tau1 [-] ! ========= DBEMT_InitInputType ======= TYPE, PUBLIC :: DBEMT_InitInputType INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] @@ -118,7 +118,17 @@ MODULE DBEMT_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: vind !< The filtered induced velocity, [1,i,j] is the axial induced velocity (-Vx*a) at node i on blade j and [2,i,j] is the tangential induced velocity (Vy*a') at node i on blade j [m/s] END TYPE DBEMT_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: DBEMT_x_element_vind = 1 ! DBEMT%element(DL%i1, DL%i2)%vind + integer(IntKi), public, parameter :: DBEMT_x_element_vind_1 = 2 ! DBEMT%element(DL%i1, DL%i2)%vind_1 + integer(IntKi), public, parameter :: DBEMT_z_DummyState = 3 ! DBEMT%DummyState + integer(IntKi), public, parameter :: DBEMT_u_AxInd_disk = 4 ! DBEMT%AxInd_disk + integer(IntKi), public, parameter :: DBEMT_u_Un_disk = 5 ! DBEMT%Un_disk + integer(IntKi), public, parameter :: DBEMT_u_R_disk = 6 ! DBEMT%R_disk + integer(IntKi), public, parameter :: DBEMT_u_element_vind_s = 7 ! DBEMT%element(DL%i1, DL%i2)%vind_s + integer(IntKi), public, parameter :: DBEMT_u_element_spanRatio = 8 ! DBEMT%element(DL%i1, DL%i2)%spanRatio + integer(IntKi), public, parameter :: DBEMT_y_vind = 9 ! DBEMT%vind + +contains subroutine DBEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(DBEMT_InitInputType), intent(in) :: SrcInitInputData @@ -1414,5 +1424,309 @@ SUBROUTINE DBEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, y_out%vind = a1*y1%vind + a2*y2%vind + a3*y3%vind END IF ! check if allocated END SUBROUTINE + +function DBEMT_InputMeshPointer(u, DL) result(Mesh) + type(DBEMT_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +function DBEMT_OutputMeshPointer(y, DL) result(Mesh) + type(DBEMT_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +subroutine DBEMT_VarsPackContState(Vars, x, ValAry) + type(DBEMT_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call DBEMT_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine DBEMT_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(DBEMT_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (DBEMT_x_element_vind) + VarVals = x%element(DL%i1, DL%i2)%vind(V%iLB:V%iUB) ! Rank 1 Array + case (DBEMT_x_element_vind_1) + VarVals = x%element(DL%i1, DL%i2)%vind_1(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine DBEMT_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(DBEMT_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call DBEMT_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine DBEMT_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(DBEMT_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (DBEMT_x_element_vind) + x%element(DL%i1, DL%i2)%vind(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (DBEMT_x_element_vind_1) + x%element(DL%i1, DL%i2)%vind_1(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function DBEMT_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (DBEMT_x_element_vind) + Name = "x%element("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")%vind" + case (DBEMT_x_element_vind_1) + Name = "x%element("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")%vind_1" + case default + Name = "Unknown Field" + end select +end function + +subroutine DBEMT_VarsPackContStateDeriv(Vars, x, ValAry) + type(DBEMT_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call DBEMT_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine DBEMT_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(DBEMT_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (DBEMT_x_element_vind) + VarVals = x%element(DL%i1, DL%i2)%vind(V%iLB:V%iUB) ! Rank 1 Array + case (DBEMT_x_element_vind_1) + VarVals = x%element(DL%i1, DL%i2)%vind_1(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine DBEMT_VarsPackConstrState(Vars, z, ValAry) + type(DBEMT_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call DBEMT_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine DBEMT_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(DBEMT_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (DBEMT_z_DummyState) + VarVals(1) = z%DummyState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine DBEMT_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(DBEMT_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call DBEMT_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine DBEMT_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(DBEMT_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (DBEMT_z_DummyState) + z%DummyState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function DBEMT_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (DBEMT_z_DummyState) + Name = "z%DummyState" + case default + Name = "Unknown Field" + end select +end function + +subroutine DBEMT_VarsPackInput(Vars, u, ValAry) + type(DBEMT_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call DBEMT_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine DBEMT_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(DBEMT_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (DBEMT_u_AxInd_disk) + VarVals(1) = u%AxInd_disk ! Scalar + case (DBEMT_u_Un_disk) + VarVals(1) = u%Un_disk ! Scalar + case (DBEMT_u_R_disk) + VarVals(1) = u%R_disk ! Scalar + case (DBEMT_u_element_vind_s) + VarVals = u%element(DL%i1, DL%i2)%vind_s(V%iLB:V%iUB) ! Rank 1 Array + case (DBEMT_u_element_spanRatio) + VarVals(1) = u%element(DL%i1, DL%i2)%spanRatio ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine DBEMT_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(DBEMT_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call DBEMT_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine DBEMT_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(DBEMT_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (DBEMT_u_AxInd_disk) + u%AxInd_disk = VarVals(1) ! Scalar + case (DBEMT_u_Un_disk) + u%Un_disk = VarVals(1) ! Scalar + case (DBEMT_u_R_disk) + u%R_disk = VarVals(1) ! Scalar + case (DBEMT_u_element_vind_s) + u%element(DL%i1, DL%i2)%vind_s(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (DBEMT_u_element_spanRatio) + u%element(DL%i1, DL%i2)%spanRatio = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function DBEMT_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (DBEMT_u_AxInd_disk) + Name = "u%AxInd_disk" + case (DBEMT_u_Un_disk) + Name = "u%Un_disk" + case (DBEMT_u_R_disk) + Name = "u%R_disk" + case (DBEMT_u_element_vind_s) + Name = "u%element("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")%vind_s" + case (DBEMT_u_element_spanRatio) + Name = "u%element("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")%spanRatio" + case default + Name = "Unknown Field" + end select +end function + +subroutine DBEMT_VarsPackOutput(Vars, y, ValAry) + type(DBEMT_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call DBEMT_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine DBEMT_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(DBEMT_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (DBEMT_y_vind) + VarVals = y%vind(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine DBEMT_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(DBEMT_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call DBEMT_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine DBEMT_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(DBEMT_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (DBEMT_y_vind) + y%vind(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + end select + end associate +end subroutine + +function DBEMT_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (DBEMT_y_vind) + Name = "y%vind" + case default + Name = "Unknown Field" + end select +end function + END MODULE DBEMT_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index caad8c1935..65b338ebcb 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -35,8 +35,8 @@ MODULE FVW_Types USE UnsteadyAero_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: idGridVelocity = 1 ! Grid stores velocity field [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: idGridVelVorticity = 2 ! Grid stores velocity and vorticity [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: idGridVelocity = 1 ! Grid stores velocity field [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: idGridVelVorticity = 2 ! Grid stores velocity and vorticity [-] ! ========= GridOutType ======= TYPE, PUBLIC :: GridOutType CHARACTER(100) :: name !< Grid name [-] @@ -352,7 +352,24 @@ MODULE FVW_Types INTEGER(IntKi) :: Dummy = 0_IntKi !< Empty parameter to satisfy framework [-] END TYPE FVW_InitOutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: FVW_x_W_Gamma_NW = 1 ! FVW%W(DL%i1)%Gamma_NW + integer(IntKi), public, parameter :: FVW_x_W_Gamma_FW = 2 ! FVW%W(DL%i1)%Gamma_FW + integer(IntKi), public, parameter :: FVW_x_W_Eps_NW = 3 ! FVW%W(DL%i1)%Eps_NW + integer(IntKi), public, parameter :: FVW_x_W_Eps_FW = 4 ! FVW%W(DL%i1)%Eps_FW + integer(IntKi), public, parameter :: FVW_x_W_r_NW = 5 ! FVW%W(DL%i1)%r_NW + integer(IntKi), public, parameter :: FVW_x_W_r_FW = 6 ! FVW%W(DL%i1)%r_FW + integer(IntKi), public, parameter :: FVW_x_UA_element_x = 7 ! FVW%UA(DL%i1)%element(DL%i2, DL%i3)%x + integer(IntKi), public, parameter :: FVW_z_W_Gamma_LL = 8 ! FVW%W(DL%i1)%Gamma_LL + integer(IntKi), public, parameter :: FVW_z_residual = 9 ! FVW%residual + integer(IntKi), public, parameter :: FVW_u_rotors_HubOrientation = 10 ! FVW%rotors(DL%i1)%HubOrientation + integer(IntKi), public, parameter :: FVW_u_rotors_HubPosition = 11 ! FVW%rotors(DL%i1)%HubPosition + integer(IntKi), public, parameter :: FVW_u_W_Vwnd_LL = 12 ! FVW%W(DL%i1)%Vwnd_LL + integer(IntKi), public, parameter :: FVW_u_W_omega_z = 13 ! FVW%W(DL%i1)%omega_z + integer(IntKi), public, parameter :: FVW_u_WingsMesh = 14 ! FVW%WingsMesh(DL%i1) + integer(IntKi), public, parameter :: FVW_u_V_wind = 15 ! FVW%V_wind + integer(IntKi), public, parameter :: FVW_y_W_Vind = 16 ! FVW%W(DL%i1)%Vind + +contains subroutine FVW_CopyGridOutType(SrcGridOutTypeData, DstGridOutTypeData, CtrlCode, ErrStat, ErrMsg) type(GridOutType), intent(in) :: SrcGridOutTypeData @@ -4079,5 +4096,363 @@ SUBROUTINE FVW_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er END DO END IF ! check if allocated END SUBROUTINE + +function FVW_InputMeshPointer(u, DL) result(Mesh) + type(FVW_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (FVW_u_WingsMesh) + Mesh => u%WingsMesh(DL%i1) + end select +end function + +function FVW_OutputMeshPointer(y, DL) result(Mesh) + type(FVW_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +subroutine FVW_VarsPackContState(Vars, x, ValAry) + type(FVW_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call FVW_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine FVW_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(FVW_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FVW_x_W_Gamma_NW) + VarVals = x%W(DL%i1)%Gamma_NW(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (FVW_x_W_Gamma_FW) + VarVals = x%W(DL%i1)%Gamma_FW(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (FVW_x_W_Eps_NW) + VarVals = x%W(DL%i1)%Eps_NW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (FVW_x_W_Eps_FW) + VarVals = x%W(DL%i1)%Eps_FW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (FVW_x_W_r_NW) + VarVals = x%W(DL%i1)%r_NW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (FVW_x_W_r_FW) + VarVals = x%W(DL%i1)%r_FW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (FVW_x_UA_element_x) + VarVals = x%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FVW_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FVW_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call FVW_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine FVW_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FVW_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FVW_x_W_Gamma_NW) + x%W(DL%i1)%Gamma_NW(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (FVW_x_W_Gamma_FW) + x%W(DL%i1)%Gamma_FW(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (FVW_x_W_Eps_NW) + x%W(DL%i1)%Eps_NW(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (FVW_x_W_Eps_FW) + x%W(DL%i1)%Eps_FW(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (FVW_x_W_r_NW) + x%W(DL%i1)%r_NW(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (FVW_x_W_r_FW) + x%W(DL%i1)%r_FW(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (FVW_x_UA_element_x) + x%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function FVW_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FVW_x_W_Gamma_NW) + Name = "x%W("//trim(Num2LStr(DL%i1))//")%Gamma_NW" + case (FVW_x_W_Gamma_FW) + Name = "x%W("//trim(Num2LStr(DL%i1))//")%Gamma_FW" + case (FVW_x_W_Eps_NW) + Name = "x%W("//trim(Num2LStr(DL%i1))//")%Eps_NW" + case (FVW_x_W_Eps_FW) + Name = "x%W("//trim(Num2LStr(DL%i1))//")%Eps_FW" + case (FVW_x_W_r_NW) + Name = "x%W("//trim(Num2LStr(DL%i1))//")%r_NW" + case (FVW_x_W_r_FW) + Name = "x%W("//trim(Num2LStr(DL%i1))//")%r_FW" + case (FVW_x_UA_element_x) + Name = "x%UA("//trim(Num2LStr(DL%i1))//")%element("//trim(Num2LStr(DL%i2))//", "//trim(Num2LStr(DL%i3))//")%x" + case default + Name = "Unknown Field" + end select +end function + +subroutine FVW_VarsPackContStateDeriv(Vars, x, ValAry) + type(FVW_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call FVW_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine FVW_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(FVW_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FVW_x_W_Gamma_NW) + VarVals = x%W(DL%i1)%Gamma_NW(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (FVW_x_W_Gamma_FW) + VarVals = x%W(DL%i1)%Gamma_FW(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (FVW_x_W_Eps_NW) + VarVals = x%W(DL%i1)%Eps_NW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (FVW_x_W_Eps_FW) + VarVals = x%W(DL%i1)%Eps_FW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (FVW_x_W_r_NW) + VarVals = x%W(DL%i1)%r_NW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (FVW_x_W_r_FW) + VarVals = x%W(DL%i1)%r_FW(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (FVW_x_UA_element_x) + VarVals = x%UA(DL%i1)%element(DL%i2, DL%i3)%x(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FVW_VarsPackConstrState(Vars, z, ValAry) + type(FVW_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call FVW_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine FVW_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(FVW_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FVW_z_W_Gamma_LL) + VarVals = z%W(DL%i1)%Gamma_LL(V%iLB:V%iUB) ! Rank 1 Array + case (FVW_z_residual) + VarVals(1) = z%residual ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FVW_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FVW_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call FVW_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine FVW_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FVW_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FVW_z_W_Gamma_LL) + z%W(DL%i1)%Gamma_LL(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (FVW_z_residual) + z%residual = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function FVW_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FVW_z_W_Gamma_LL) + Name = "z%W("//trim(Num2LStr(DL%i1))//")%Gamma_LL" + case (FVW_z_residual) + Name = "z%residual" + case default + Name = "Unknown Field" + end select +end function + +subroutine FVW_VarsPackInput(Vars, u, ValAry) + type(FVW_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call FVW_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine FVW_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(FVW_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FVW_u_rotors_HubOrientation) + VarVals = u%rotors(DL%i1)%HubOrientation(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (FVW_u_rotors_HubPosition) + VarVals = u%rotors(DL%i1)%HubPosition(V%iLB:V%iUB) ! Rank 1 Array + case (FVW_u_W_Vwnd_LL) + VarVals = u%W(DL%i1)%Vwnd_LL(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (FVW_u_W_omega_z) + VarVals = u%W(DL%i1)%omega_z(V%iLB:V%iUB) ! Rank 1 Array + case (FVW_u_WingsMesh) + call MV_PackMesh(V, u%WingsMesh(DL%i1), ValAry) ! Mesh + case (FVW_u_V_wind) + VarVals = u%V_wind(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FVW_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FVW_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call FVW_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine FVW_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FVW_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FVW_u_rotors_HubOrientation) + u%rotors(DL%i1)%HubOrientation(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (FVW_u_rotors_HubPosition) + u%rotors(DL%i1)%HubPosition(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (FVW_u_W_Vwnd_LL) + u%W(DL%i1)%Vwnd_LL(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (FVW_u_W_omega_z) + u%W(DL%i1)%omega_z(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (FVW_u_WingsMesh) + call MV_UnpackMesh(V, ValAry, u%WingsMesh(DL%i1)) ! Mesh + case (FVW_u_V_wind) + u%V_wind(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + +function FVW_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FVW_u_rotors_HubOrientation) + Name = "u%rotors("//trim(Num2LStr(DL%i1))//")%HubOrientation" + case (FVW_u_rotors_HubPosition) + Name = "u%rotors("//trim(Num2LStr(DL%i1))//")%HubPosition" + case (FVW_u_W_Vwnd_LL) + Name = "u%W("//trim(Num2LStr(DL%i1))//")%Vwnd_LL" + case (FVW_u_W_omega_z) + Name = "u%W("//trim(Num2LStr(DL%i1))//")%omega_z" + case (FVW_u_WingsMesh) + Name = "u%WingsMesh("//trim(Num2LStr(DL%i1))//")" + case (FVW_u_V_wind) + Name = "u%V_wind" + case default + Name = "Unknown Field" + end select +end function + +subroutine FVW_VarsPackOutput(Vars, y, ValAry) + type(FVW_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call FVW_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine FVW_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(FVW_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FVW_y_W_Vind) + VarVals = y%W(DL%i1)%Vind(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FVW_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FVW_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call FVW_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine FVW_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FVW_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FVW_y_W_Vind) + y%W(DL%i1)%Vind(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + +function FVW_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FVW_y_W_Vind) + Name = "y%W("//trim(Num2LStr(DL%i1))//")%Vind" + case default + Name = "Unknown Field" + end select +end function + END MODULE FVW_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index 8f26807364..5d1773010d 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -34,10 +34,10 @@ MODULE UnsteadyAero_Types USE AirfoilInfo_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Method_RK4 = 1 ! RK4 integration method [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Method_AB4 = 2 ! AB4 integration method [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Method_ABM4 = 3 ! ABM4 integration method [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Method_BDF2 = 4 ! BDF2 integration method [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Method_RK4 = 1 ! RK4 integration method [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Method_AB4 = 2 ! AB4 integration method [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Method_ABM4 = 3 ! ABM4 integration method [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Method_BDF2 = 4 ! BDF2 integration method [-] ! ========= UA_InitInputType ======= TYPE, PUBLIC :: UA_InitInputType REAL(DbKi) :: dt = 0.0_R8Ki !< time step [s] @@ -249,7 +249,22 @@ MODULE UnsteadyAero_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< outputs to be written to a file [-] END TYPE UA_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: UA_x_element_x = 1 ! UA%element(DL%i1, DL%i2)%x + integer(IntKi), public, parameter :: UA_z_DummyConstraintState = 2 ! UA%DummyConstraintState + integer(IntKi), public, parameter :: UA_u_U = 3 ! UA%U + integer(IntKi), public, parameter :: UA_u_alpha = 4 ! UA%alpha + integer(IntKi), public, parameter :: UA_u_Re = 5 ! UA%Re + integer(IntKi), public, parameter :: UA_u_UserProp = 6 ! UA%UserProp + integer(IntKi), public, parameter :: UA_u_v_ac = 7 ! UA%v_ac + integer(IntKi), public, parameter :: UA_u_omega = 8 ! UA%omega + integer(IntKi), public, parameter :: UA_y_Cn = 9 ! UA%Cn + integer(IntKi), public, parameter :: UA_y_Cc = 10 ! UA%Cc + integer(IntKi), public, parameter :: UA_y_Cm = 11 ! UA%Cm + integer(IntKi), public, parameter :: UA_y_Cl = 12 ! UA%Cl + integer(IntKi), public, parameter :: UA_y_Cd = 13 ! UA%Cd + integer(IntKi), public, parameter :: UA_y_WriteOutput = 14 ! UA%WriteOutput + +contains subroutine UA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(UA_InitInputType), intent(in) :: SrcInitInputData @@ -2524,5 +2539,337 @@ SUBROUTINE UA_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function UA_InputMeshPointer(u, DL) result(Mesh) + type(UA_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +function UA_OutputMeshPointer(y, DL) result(Mesh) + type(UA_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +subroutine UA_VarsPackContState(Vars, x, ValAry) + type(UA_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call UA_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine UA_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(UA_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (UA_x_element_x) + VarVals = x%element(DL%i1, DL%i2)%x(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine UA_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(UA_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call UA_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine UA_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(UA_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (UA_x_element_x) + x%element(DL%i1, DL%i2)%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function UA_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (UA_x_element_x) + Name = "x%element("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")%x" + case default + Name = "Unknown Field" + end select +end function + +subroutine UA_VarsPackContStateDeriv(Vars, x, ValAry) + type(UA_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call UA_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine UA_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(UA_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (UA_x_element_x) + VarVals = x%element(DL%i1, DL%i2)%x(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine UA_VarsPackConstrState(Vars, z, ValAry) + type(UA_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call UA_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine UA_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(UA_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (UA_z_DummyConstraintState) + VarVals(1) = z%DummyConstraintState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine UA_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(UA_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call UA_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine UA_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(UA_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (UA_z_DummyConstraintState) + z%DummyConstraintState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function UA_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (UA_z_DummyConstraintState) + Name = "z%DummyConstraintState" + case default + Name = "Unknown Field" + end select +end function + +subroutine UA_VarsPackInput(Vars, u, ValAry) + type(UA_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call UA_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine UA_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(UA_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (UA_u_U) + VarVals(1) = u%U ! Scalar + case (UA_u_alpha) + VarVals(1) = u%alpha ! Scalar + case (UA_u_Re) + VarVals(1) = u%Re ! Scalar + case (UA_u_UserProp) + VarVals(1) = u%UserProp ! Scalar + case (UA_u_v_ac) + VarVals = u%v_ac(V%iLB:V%iUB) ! Rank 1 Array + case (UA_u_omega) + VarVals(1) = u%omega ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine UA_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(UA_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call UA_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine UA_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(UA_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (UA_u_U) + u%U = VarVals(1) ! Scalar + case (UA_u_alpha) + u%alpha = VarVals(1) ! Scalar + case (UA_u_Re) + u%Re = VarVals(1) ! Scalar + case (UA_u_UserProp) + u%UserProp = VarVals(1) ! Scalar + case (UA_u_v_ac) + u%v_ac(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (UA_u_omega) + u%omega = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function UA_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (UA_u_U) + Name = "u%U" + case (UA_u_alpha) + Name = "u%alpha" + case (UA_u_Re) + Name = "u%Re" + case (UA_u_UserProp) + Name = "u%UserProp" + case (UA_u_v_ac) + Name = "u%v_ac" + case (UA_u_omega) + Name = "u%omega" + case default + Name = "Unknown Field" + end select +end function + +subroutine UA_VarsPackOutput(Vars, y, ValAry) + type(UA_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call UA_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine UA_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(UA_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (UA_y_Cn) + VarVals(1) = y%Cn ! Scalar + case (UA_y_Cc) + VarVals(1) = y%Cc ! Scalar + case (UA_y_Cm) + VarVals(1) = y%Cm ! Scalar + case (UA_y_Cl) + VarVals(1) = y%Cl ! Scalar + case (UA_y_Cd) + VarVals(1) = y%Cd ! Scalar + case (UA_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine UA_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(UA_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call UA_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine UA_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(UA_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (UA_y_Cn) + y%Cn = VarVals(1) ! Scalar + case (UA_y_Cc) + y%Cc = VarVals(1) ! Scalar + case (UA_y_Cm) + y%Cm = VarVals(1) ! Scalar + case (UA_y_Cl) + y%Cl = VarVals(1) ! Scalar + case (UA_y_Cd) + y%Cd = VarVals(1) ! Scalar + case (UA_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function UA_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (UA_y_Cn) + Name = "y%Cn" + case (UA_y_Cc) + Name = "y%Cc" + case (UA_y_Cm) + Name = "y%Cm" + case (UA_y_Cl) + Name = "y%Cl" + case (UA_y_Cd) + Name = "y%Cd" + case (UA_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE UnsteadyAero_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/awae/src/AWAE_Types.f90 b/modules/awae/src/AWAE_Types.f90 index 06e9a5b90a..fadc1131bc 100644 --- a/modules/awae/src/AWAE_Types.f90 +++ b/modules/awae/src/AWAE_Types.f90 @@ -34,12 +34,12 @@ MODULE AWAE_Types USE InflowWind_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: XYSlice = 1 ! Extract an XY slice of data from the 3D grid [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: YZSlice = 2 ! Extract an YZ slice of data from the 3D grid [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: XZSlice = 3 ! Extract an XZ slice of data from the 3D grid [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: MeanderMod_Uniform = 1 ! Spatial filter model for wake meandering: uniform [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: MeanderMod_TruncJinc = 2 ! Spatial filter model for wake meandering: truncated jinc [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: MeanderMod_WndwdJinc = 3 ! Spatial filter model for wake meandering: windowed jinc [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: XYSlice = 1 ! Extract an XY slice of data from the 3D grid [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: YZSlice = 2 ! Extract an YZ slice of data from the 3D grid [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: XZSlice = 3 ! Extract an XZ slice of data from the 3D grid [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MeanderMod_Uniform = 1 ! Spatial filter model for wake meandering: uniform [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MeanderMod_TruncJinc = 2 ! Spatial filter model for wake meandering: truncated jinc [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MeanderMod_WndwdJinc = 3 ! Spatial filter model for wake meandering: windowed jinc [-] ! ========= AWAE_HighWindGrid ======= TYPE, PUBLIC :: AWAE_HighWindGrid REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: data => NULL() !< UVW components of wind data across the high-res regularly-spaced grid [m/s] @@ -252,7 +252,21 @@ MODULE AWAE_Types REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: WAT_k !< Scaling factor for each wake plane and turbine (ny, nz, np, nWT) [-] END TYPE AWAE_InputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: AWAE_x_IfW_DummyContState = 1 ! AWAE%IfW(DL%i1)%DummyContState + integer(IntKi), public, parameter :: AWAE_z_IfW_DummyConstrState = 2 ! AWAE%IfW(DL%i1)%DummyConstrState + integer(IntKi), public, parameter :: AWAE_u_xhat_plane = 3 ! AWAE%xhat_plane + integer(IntKi), public, parameter :: AWAE_u_p_plane = 4 ! AWAE%p_plane + integer(IntKi), public, parameter :: AWAE_u_Vx_wake = 5 ! AWAE%Vx_wake + integer(IntKi), public, parameter :: AWAE_u_Vy_wake = 6 ! AWAE%Vy_wake + integer(IntKi), public, parameter :: AWAE_u_Vz_wake = 7 ! AWAE%Vz_wake + integer(IntKi), public, parameter :: AWAE_u_D_wake = 8 ! AWAE%D_wake + integer(IntKi), public, parameter :: AWAE_u_WAT_k = 9 ! AWAE%WAT_k + integer(IntKi), public, parameter :: AWAE_y_Vdist_High_data = 10 ! AWAE%Vdist_High(DL%i1)%data + integer(IntKi), public, parameter :: AWAE_y_V_plane = 11 ! AWAE%V_plane + integer(IntKi), public, parameter :: AWAE_y_TI_amb = 12 ! AWAE%TI_amb + integer(IntKi), public, parameter :: AWAE_y_Vx_wind_disk = 13 ! AWAE%Vx_wind_disk + +contains subroutine AWAE_CopyHighWindGrid(SrcHighWindGridData, DstHighWindGridData, CtrlCode, ErrStat, ErrMsg) type(AWAE_HighWindGrid), intent(in) :: SrcHighWindGridData @@ -2594,5 +2608,331 @@ subroutine AWAE_UnPackInput(RF, OutData) call RegUnpackAlloc(RF, OutData%D_wake); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WAT_k); if (RegCheckErr(RF, RoutineName)) return end subroutine + +function AWAE_InputMeshPointer(u, DL) result(Mesh) + type(AWAE_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +function AWAE_OutputMeshPointer(y, DL) result(Mesh) + type(AWAE_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +subroutine AWAE_VarsPackContState(Vars, x, ValAry) + type(AWAE_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call AWAE_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine AWAE_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(AWAE_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AWAE_x_IfW_DummyContState) + VarVals(1) = x%IfW(DL%i1)%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AWAE_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AWAE_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call AWAE_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine AWAE_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(AWAE_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AWAE_x_IfW_DummyContState) + x%IfW(DL%i1)%DummyContState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function AWAE_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AWAE_x_IfW_DummyContState) + Name = "x%IfW("//trim(Num2LStr(DL%i1))//")%DummyContState" + case default + Name = "Unknown Field" + end select +end function + +subroutine AWAE_VarsPackContStateDeriv(Vars, x, ValAry) + type(AWAE_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call AWAE_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine AWAE_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(AWAE_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AWAE_x_IfW_DummyContState) + VarVals(1) = x%IfW(DL%i1)%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AWAE_VarsPackConstrState(Vars, z, ValAry) + type(AWAE_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call AWAE_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine AWAE_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(AWAE_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AWAE_z_IfW_DummyConstrState) + VarVals(1) = z%IfW(DL%i1)%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AWAE_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AWAE_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call AWAE_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine AWAE_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(AWAE_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AWAE_z_IfW_DummyConstrState) + z%IfW(DL%i1)%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function AWAE_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AWAE_z_IfW_DummyConstrState) + Name = "z%IfW("//trim(Num2LStr(DL%i1))//")%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine AWAE_VarsPackInput(Vars, u, ValAry) + type(AWAE_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call AWAE_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine AWAE_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(AWAE_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AWAE_u_xhat_plane) + VarVals = u%xhat_plane(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (AWAE_u_p_plane) + VarVals = u%p_plane(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (AWAE_u_Vx_wake) + VarVals = u%Vx_wake(V%iLB:V%iUB, V%j, V%k, V%m) ! Rank 4 Array + case (AWAE_u_Vy_wake) + VarVals = u%Vy_wake(V%iLB:V%iUB, V%j, V%k, V%m) ! Rank 4 Array + case (AWAE_u_Vz_wake) + VarVals = u%Vz_wake(V%iLB:V%iUB, V%j, V%k, V%m) ! Rank 4 Array + case (AWAE_u_D_wake) + VarVals = u%D_wake(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (AWAE_u_WAT_k) + VarVals = u%WAT_k(V%iLB:V%iUB, V%j, V%k, V%m) ! Rank 4 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AWAE_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AWAE_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call AWAE_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine AWAE_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(AWAE_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AWAE_u_xhat_plane) + u%xhat_plane(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (AWAE_u_p_plane) + u%p_plane(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (AWAE_u_Vx_wake) + u%Vx_wake(V%iLB:V%iUB, V%j, V%k, V%m) = VarVals ! Rank 4 Array + case (AWAE_u_Vy_wake) + u%Vy_wake(V%iLB:V%iUB, V%j, V%k, V%m) = VarVals ! Rank 4 Array + case (AWAE_u_Vz_wake) + u%Vz_wake(V%iLB:V%iUB, V%j, V%k, V%m) = VarVals ! Rank 4 Array + case (AWAE_u_D_wake) + u%D_wake(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (AWAE_u_WAT_k) + u%WAT_k(V%iLB:V%iUB, V%j, V%k, V%m) = VarVals ! Rank 4 Array + end select + end associate +end subroutine + +function AWAE_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AWAE_u_xhat_plane) + Name = "u%xhat_plane" + case (AWAE_u_p_plane) + Name = "u%p_plane" + case (AWAE_u_Vx_wake) + Name = "u%Vx_wake" + case (AWAE_u_Vy_wake) + Name = "u%Vy_wake" + case (AWAE_u_Vz_wake) + Name = "u%Vz_wake" + case (AWAE_u_D_wake) + Name = "u%D_wake" + case (AWAE_u_WAT_k) + Name = "u%WAT_k" + case default + Name = "Unknown Field" + end select +end function + +subroutine AWAE_VarsPackOutput(Vars, y, ValAry) + type(AWAE_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call AWAE_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine AWAE_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(AWAE_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AWAE_y_Vdist_High_data) + VarVals = y%Vdist_High(DL%i1)%data(V%iLB:V%iUB, V%j, V%k, V%m, V%n) ! Rank 5 Array + case (AWAE_y_V_plane) + VarVals = y%V_plane(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (AWAE_y_TI_amb) + VarVals = y%TI_amb(V%iLB:V%iUB) ! Rank 1 Array + case (AWAE_y_Vx_wind_disk) + VarVals = y%Vx_wind_disk(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine AWAE_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(AWAE_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call AWAE_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine AWAE_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(AWAE_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (AWAE_y_Vdist_High_data) + y%Vdist_High(DL%i1)%data(V%iLB:V%iUB, V%j, V%k, V%m, V%n) = VarVals ! Rank 5 Array + case (AWAE_y_V_plane) + y%V_plane(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (AWAE_y_TI_amb) + y%TI_amb(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (AWAE_y_Vx_wind_disk) + y%Vx_wind_disk(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function AWAE_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (AWAE_y_Vdist_High_data) + Name = "y%Vdist_High("//trim(Num2LStr(DL%i1))//")%data" + case (AWAE_y_V_plane) + Name = "y%V_plane" + case (AWAE_y_TI_amb) + Name = "y%TI_amb" + case (AWAE_y_Vx_wind_disk) + Name = "y%Vx_wind_disk" + case default + Name = "Unknown Field" + end select +end function + END MODULE AWAE_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 86d3382a47..d3dbcffd8d 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -48,7 +48,6 @@ MODULE BeamDyn PUBLIC :: BD_JacobianPConstrState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - ! (Xd), and constraint - state(Z) functions all with respect to the constraint ! states(z) - PUBLIC :: BD_GetOP !< Routine to pack the operating point values (for linearization) into arrays PUBLIC :: BD_UpdateGlobalRef !< update the BeamDyn reference. The reference for the calculations follows u%RootMotionMesh ! and therefore x%q must be updated from T -> T+DT to include the root motion from T->T+DT @@ -58,8 +57,8 @@ MODULE BeamDyn ! the development of the tight coupling algorithm for OpenFAST, we decided to try changing all the states in BeamDyn to ! follow the moving BladeRootMotion mesh. This requires changing the states after an UpdateStates call to be relative to ! the new BladeRootMotion mesh orientation and position. - ! Upadate the reference frame after each State update (or use the old method)? - LOGICAL, PARAMETER :: ChangeRefFrame = .false. + ! Update the reference frame after each State update (or use the old method)? + LOGICAL, PARAMETER :: ChangeRefFrame = .true. CONTAINS @@ -246,16 +245,19 @@ SUBROUTINE BD_Init( InitInp, u, p, x, xd, z, OtherState, y, MiscVar, Interval, I !............................................................................................ - ! Initialize Jacobian: + ! Module Variables + !............................................................................................ + + ! call BD_InitVars(u, p, x, y, MiscVar, InitOut, InitInp%Linearize, ErrStat2, ErrMsg2) + call BD_InitVars(u, p, x, y, MiscVar, InitOut, .true., ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + !............................................................................................ + ! Summary and cleanup !............................................................................................ - if (InitInp%Linearize) then - call Init_Jacobian( p, u, y, MiscVar, InitOut, ErrStat2, ErrMsg2); if (Failed()) return - end if - call Cleanup() - return CONTAINS SUBROUTINE Cleanup() if (allocated(GLL_nodes )) deallocate(GLL_nodes ) @@ -921,8 +923,7 @@ subroutine SetParameters(InitInp, InputFileData, p, OtherState, ErrStat, ErrMsg) p%RotStates = InputFileData%RotStates ! Rotate states in linearization? - if (ChangeRefFrame) p%RotStates = .true. - p%RelStates = InputFileData%RelStates ! Define states relative to root motion in linearization? + ! if (ChangeRefFrame) p%RotStates = .true. p%rhoinf = InputFileData%rhoinf ! Numerical damping coefficient: [0,1]. No numerical damping if rhoinf = 1; maximum numerical damping if rhoinf = 0. p%dt = InputFileData%DTBeam ! Time step size @@ -1966,19 +1967,17 @@ 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 + LOGICAL :: IsFullLin - ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = "" AllOuts = 0.0_ReKi if (present(NeedWriteOutput)) then - CalcWriteOutput = NeedWriteOutput + IsFullLin = NeedWriteOutput else - CalcWriteOutput = .true. ! by default, calculate WriteOutput unless told that we do not need it + IsFullLin = .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. @@ -2079,13 +2078,13 @@ 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, CalcWriteOutput ) !uses m%u2 + call Calc_WriteOutput( p, AllOuts, y, m, ErrStat2, ErrMsg2, IsFullLin ) !uses m%u2 CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) y%RootMxr = AllOuts( RootMxr ) y%RootMyr = AllOuts( RootMyr ) - if (CalcWriteOutput) then + if (IsFullLin) then !............................................................................................................................... ! Place the selected output channels into the WriteOutput(:) array with the proper sign: !............................................................................................................................... @@ -2365,8 +2364,8 @@ SUBROUTINE BD_DisplacementQP( nelem, p, x, m ) TYPE(BD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< misc/optimization variables - INTEGER(IntKi) :: ErrStat !< Ignored error handling for LAPACK_GEMM - CHARACTER(ErrMsgLen) :: ErrMsg !< Ignored error handling for LAPACK_GEMM + INTEGER(IntKi) :: ErrStat !< index to current element + CHARACTER(ErrMsgLen) :: ErrMsg !< index to current element INTEGER(IntKi) :: idx_qp !< index to the current quadrature point INTEGER(IntKi) :: elem_start !< Node point of first node in current element @@ -2392,9 +2391,8 @@ SUBROUTINE BD_DisplacementQP( nelem, p, x, m ) elem_start = p%node_elem_idx(nelem,1) ! Use matrix multiplication to interpolate position and position derivative to quadrature points - ! NOTE: errors from LAPACK_GEMM can only be due to matrix size mismatch, so they can be safely ignored if matrices are correct size - call LAPACK_GEMM('N','N', 1.0_BDKi, x%q(1:3,elem_start:elem_start+p%nodes_per_elem-1), p%Shp, 0.0_BDKi, m%qp%uuu(1:3,:,nelem), ErrStat, ErrMsg) - call LAPACK_GEMM('N','N', 1.0_BDKi, x%q(1:3,elem_start:elem_start+p%nodes_per_elem-1), p%ShpDer, 0.0_BDKi, m%qp%uup(1:3,:,nelem), ErrStat, ErrMsg) + call LAPACK_DGEMM('N','N', 1.0_BDKi, x%q(1:3,elem_start:elem_start+p%nodes_per_elem-1), p%Shp, 0.0_BDKi, m%qp%uuu(1:3,:,nelem), ErrStat, ErrMsg) + call LAPACK_DGEMM('N','N', 1.0_BDKi, x%q(1:3,elem_start:elem_start+p%nodes_per_elem-1), p%ShpDer, 0.0_BDKi, m%qp%uup(1:3,:,nelem), ErrStat, ErrMsg) ! Apply Jacobian to get position derivative with respect to X-axis do idx_qp = 1, p%nqp @@ -2420,8 +2418,8 @@ SUBROUTINE BD_RotationalInterpQP( nelem, p, x, m ) TYPE(BD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< misc/optimization variables - INTEGER(IntKi) :: ErrStat !< Ignored error handling for LAPACK_GEMM - CHARACTER(ErrMsgLen) :: ErrMsg !< Ignored error handling for LAPACK_GEMM + INTEGER(IntKi) :: ErrStat !< index to current element + CHARACTER(ErrMsgLen) :: ErrMsg !< index to current element INTEGER(IntKi) :: idx_qp !< index to the current quadrature point INTEGER(IntKi) :: elem_start !< Node point of first node in current element INTEGER(IntKi) :: idx_node !< index to current GLL point in element @@ -2486,9 +2484,8 @@ SUBROUTINE BD_RotationalInterpQP( nelem, p, x, m ) ! Use matrix multiplication to interpolate rotation and rotation derivative to quadrature points ! These rotations do not include the root node rotation at this point (added later in function) - ! NOTE: errors from LAPACK_GEMM can only be due to matrix size mismatch, so they can be safely ignored if matrices are correct size - call LAPACK_GEMM('N','N', 1.0_BDKi, m%Nrrr(:,:,nelem), p%Shp, 0.0_BDKi, m%qp%uuu(4:6,:,nelem), ErrStat, ErrMsg) - call LAPACK_GEMM('N','N', 1.0_BDKi, m%Nrrr(:,:,nelem), p%ShpDer, 0.0_BDKi, m%qp%uup(4:6,:,nelem), ErrStat, ErrMsg) + call LAPACK_DGEMM('N','N', 1.0_BDKi, m%Nrrr(:,:,nelem), p%Shp, 0.0_BDKi, m%qp%uuu(4:6,:,nelem), ErrStat, ErrMsg) + call LAPACK_DGEMM('N','N', 1.0_BDKi, m%Nrrr(:,:,nelem), p%ShpDer, 0.0_BDKi, m%qp%uup(4:6,:,nelem), ErrStat, ErrMsg) ! Apply Jacobian to get rotation derivative with respect to X-axis do idx_qp = 1, p%nqp @@ -2957,8 +2954,8 @@ SUBROUTINE BD_QPDataVelocity( p, x, m ) TYPE(BD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi) :: ErrStat !< Ignored error handling for LAPACK_GEMM - CHARACTER(ErrMsgLen) :: ErrMsg !< Ignored error handling for LAPACK_GEMM + INTEGER(IntKi) :: ErrStat !< index to current element + CHARACTER(ErrMsgLen) :: ErrMsg !< index to current element INTEGER(IntKi) :: nelem !< index to current element INTEGER(IntKi) :: idx_qp !< index to quadrature point INTEGER(IntKi) :: elem_start !< Starting quadrature point of current element @@ -2972,9 +2969,8 @@ SUBROUTINE BD_QPDataVelocity( p, x, m ) elem_start = p%node_elem_idx(nelem,1) ! Use matrix multiplication to interpolate velocity and velocity derivative to quadrature points - ! NOTE: errors from LAPACK_GEMM can only be due to matrix size mismatch, so they can be safely ignored if matrices are correct size - call LAPACK_GEMM('N','N', 1.0_BDKi, x%dqdt(:,elem_start:elem_start+p%nodes_per_elem-1), p%Shp, 0.0_BDKi, m%qp%vvv(:,:,nelem), ErrStat, ErrMsg) - call LAPACK_GEMM('N','N', 1.0_BDKi, x%dqdt(:,elem_start:elem_start+p%nodes_per_elem-1), p%ShpDer, 0.0_BDKi, m%qp%vvp(:,:,nelem), ErrStat, ErrMsg) + call LAPACK_DGEMM('N','N', 1.0_BDKi, x%dqdt(:,elem_start:elem_start+p%nodes_per_elem-1), p%Shp, 0.0_BDKi, m%qp%vvv(:,:,nelem), ErrStat, ErrMsg) + call LAPACK_DGEMM('N','N', 1.0_BDKi, x%dqdt(:,elem_start:elem_start+p%nodes_per_elem-1), p%ShpDer, 0.0_BDKi, m%qp%vvp(:,:,nelem), ErrStat, ErrMsg) ! Apply Jacobian to get velocity derivative with respect to X-axis do idx_qp = 1, p%nqp @@ -3000,8 +2996,8 @@ SUBROUTINE BD_QPDataAcceleration( p, OtherState, m ) TYPE(BD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t on input; at t+dt on outputs TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi) :: ErrStat !< Ignored error handling for LAPACK_GEMM - CHARACTER(ErrMsgLen) :: ErrMsg !< Ignored error handling for LAPACK_GEMM + INTEGER(IntKi) :: ErrStat !< index to current element + CHARACTER(ErrMsgLen) :: ErrMsg !< index to current element INTEGER(IntKi) :: nelem !< index of current element INTEGER(IntKi) :: idx_qp !< index of current quadrature point INTEGER(IntKi) :: idx_node @@ -5859,15 +5855,214 @@ SUBROUTINE PitchActuator_SetBC(p, u, xd, AllOuts) END SUBROUTINE PitchActuator_SetBC + +subroutine BD_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(BD_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(BD_ParameterType), intent(inout) :: p !< Parameters + type(BD_ContinuousStateType), intent(inout) :: x !< Continuous state + type(BD_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(BD_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(BD_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + logical, intent(in ) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'BD_InitVars' + INTEGER(IntKi) :: ErrStat2 ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + + integer(IntKi) :: i, j, Flags, idx + REAL(R8Ki) :: MaxThrust, MaxTorque + CHARACTER(200) :: label + + ErrStat = ErrID_None + ErrMsg = "" + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Add pointers to vars to initialization output + InitOut%Vars => p%Vars + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + ! Set flags to AeroMap, if rotating states is true, set flags to rotating states + Flags = ior(VF_AeroMap, VF_DerivOrder2) + if (p%RotStates) Flags = ior(Flags, VF_RotFrame) + + ! Add translation displacement and orientation variables at blade nodes + ! Note: the first node is not included as it is a constraint state + do i = 2, p%node_total + label = 'finite element node '//trim(num2lstr(i))//' (number of elements = '//& + trim(num2lstr(p%elem_total))//'; element order = '//trim(num2lstr(p%nodes_per_elem-1))//')' + + call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), FieldTransDisp, & + DatLoc(BD_x_q), iAry=1, jAry=i, Num=3, & + Flags=Flags, & + Perturb=0.2_BDKi*D2R_D * p%blade_length, & + LinNames=[trim(label)//' translational displacement in X, m', & + trim(label)//' translational displacement in Y, m', & + trim(label)//' translational displacement in Z, m']) + + call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), FieldOrientation, & + DatLoc(BD_x_q), iAry=4, jAry=i, Num=3, & + Flags=ior(Flags, VF_WM_Rot), & + Perturb=0.2_BDKi*D2R_D, & + LinNames=[trim(label)//' rotational displacement in X, rad', & + trim(label)//' rotational displacement in Y, rad', & + trim(label)//' rotational displacement in Z, rad']) + end do + + ! Add translation and angular velocity at blade nodes + do i = 2, p%node_total + label = 'First time derivative of finite element node '//trim(num2lstr(i))//' (number of elements = '//& + trim(num2lstr(p%elem_total))//'; element order = '//trim(num2lstr(p%nodes_per_elem-1))//')' + + call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), FieldTransVel, & + DatLoc(BD_x_dqdt), iAry=1, jAry=i, Num=3, & + Flags=Flags, & + Perturb=0.2_BDKi*D2R_D * p%blade_length, & + LinNames=[trim(label)//' translational displacement in X, m/s', & + trim(label)//' translational displacement in Y, m/s', & + trim(label)//' translational displacement in Z, m/s']) + + call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), FieldAngularVel, & + DatLoc(BD_x_dqdt), iAry=4, jAry=i, Num=3, & + Flags=Flags, & + Perturb=0.2_BDKi*D2R_D, & + LinNames=[trim(label)//' rotational displacement in X, rad/s', & + trim(label)//' rotational displacement in Y, rad/s', & + trim(label)//' rotational displacement in Z, rad/s']) + end do + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + MaxThrust = 170.0_R8Ki*p%blade_length**2 + MaxTorque = 14.0_R8Ki*p%blade_length**3 + + call MV_AddMeshVar(p%Vars%u, "RootMotion", MotionFields, & + DatLoc(BD_u_RootMotion), & + Mesh=u%RootMotion, & + Perturbs=[0.2_R8Ki*D2R_D * p%blade_length, & ! FieldTransDisp + 0.2_R8Ki*D2R_D, & ! FieldOrientation + 0.2_R8Ki*D2R_D * p%blade_length, & ! FieldTransVel + 0.2_R8Ki*D2R_D, & ! FieldAngularVel + 0.2_R8Ki*D2R_D * p%blade_length, & ! FieldTransAcc + 0.2_R8Ki*D2R_D]) ! FieldAngularAcc + + call MV_AddMeshVar(p%Vars%u, "PointLoad", LoadFields, & + DatLoc(BD_u_PointLoad), & + Mesh=u%PointLoad, & + Perturbs=[MaxThrust/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes), & ! FieldForce + MaxTorque/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes)]) ! FieldMoment + + call MV_AddMeshVar(p%Vars%u, "DistrLoad", LoadFields, & + DatLoc(BD_u_DistrLoad), & + Flags=ior(VF_Line, VF_AeroMap), & + Mesh=u%DistrLoad, & + Perturbs=[MaxThrust/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes), & ! FieldForce + MaxTorque/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes)]) ! FieldMoment + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + call MV_AddMeshVar(p%Vars%y, 'Reaction force', LoadFields, DatLoc(BD_y_ReactionForce), Mesh=y%ReactionForce) + + call MV_AddMeshVar(p%Vars%y, 'Blade motion', [FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel], & + DatLoc(BD_y_BldMotion), & + Flags=VF_AeroMap, & + Mesh=y%BldMotion) + call MV_AddMeshVar(p%Vars%y, 'Blade motion', [FieldTransAcc, FieldAngularAcc], DatLoc(BD_y_BldMotion), & + Mesh=y%BldMotion) + + do i = 1, p%NumOuts + call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, FieldScalar, & + DatLoc(BD_y_WriteOutput), iAry=i, & + Flags=VF_WriteOut + OutParamFlags(p%OutParam(i)%Indx), & + LinNames=[trim(p%OutParam(i)%Name)//', '//trim(p%OutParam(i)%Units)], & + Active=p%OutParam(i)%Indx > 0) + end do + + idx = p%NumOuts + 1 + do i = 1, p%BldNd_NumOuts + call MV_AddVar(p%Vars%y, p%BldNd_OutParam(i)%Name, FieldScalar, & + DatLoc(BD_y_WriteOutput), iAry=idx, & + Num=size(p%BldNd_BlOutNd), & + Flags=VF_WriteOut + BldNd_OutParamFlags(p%BldNd_OutParam(i)%Name), & + LinNames=[(BldNd_LinChan(p%BldNd_OutParam(i), j), j=1,size(p%BldNd_BlOutNd))], & + Active=p%BldNd_OutParam(i)%Indx > 0) + idx = idx + size(p%BldNd_BlOutNd) + end do + + !---------------------------------------------------------------------------- + ! Initialize Variables and Values + !---------------------------------------------------------------------------- + + CALL MV_InitVarsJac(p%Vars, m%Jac, Linearize .or. p%CompAeroMaps, ErrStat2, ErrMsg2); if (Failed()) return + + call BD_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call BD_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call BD_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call BD_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + +contains + + pure integer(IntKi) function OutParamFlags(indx) + integer(IntKi), intent(in) :: indx + integer(IntKi), parameter :: GlobalFrameIndices(*) = [& + TipTVXg, TipTVYg, TipTVZg, TipRVXg, TipRVYg, TipRVZg, NTVg, NRVg] + if (any(GlobalFrameIndices == indx)) then + OutParamFlags = VF_None + else + OutParamFlags = VF_RotFrame + end if + end function + + pure integer(IntKi) function BldNd_OutParamFlags(ChannelName) + character(*), intent(in) :: ChannelName + integer(IntKi) :: k + ! Get index of last character in channel name + k = len_trim(ChannelName) + ! If last letter is uppercase or lowercase G, then frame is global + if (ChannelName(k:k) == 'G' .or. ChannelName(k:k) == 'g') then + BldNd_OutParamFlags = VF_None + else + BldNd_OutParamFlags = VF_RotFrame + end if + end function + + pure character(LinChanLen) function BldNd_LinChan(BldNd_OutParam, IdxNode) result(name) + type(OutParmType), intent(in) :: BldNd_OutParam + integer(IntKi), intent(in) :: IdxNode + write(name, '("N",I3.3,A,", ",A)') IdxNode, trim(BldNd_OutParam%Name), trim(BldNd_OutParam%Units) + end function + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! ###### The following four routines are Jacobian routines for linearization capabilities ####### ! If the module does not implement them, set ErrStat = ErrID_Fatal in BD_Init() when InitInp%Linearize is .true. !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and DZ/du are returned. -SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, StateRel_x, StateRel_xdot) -!.................................................................................................................................. +SUBROUTINE BD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) + type(ModVarsType), INTENT(IN ) :: Vars !< Module variables 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) TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -5882,274 +6077,144 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM 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 - 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] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: StateRel_x(:,:) !< Matrix by which the displacement states are optionally converted relative to root - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: StateRel_xdot(:,:) !< Matrix by which the velocity states are optionally converted relative to root - - - ! local variables - TYPE(BD_OutputType) :: y_p - TYPE(BD_OutputType) :: y_m - TYPE(BD_ContinuousStateType) :: x_p - TYPE(BD_ContinuousStateType) :: x_m - TYPE(BD_InputType) :: u_perturb - REAL(R8Ki) :: delta_p, delta_m ! delta change in input (plus, minus) - INTEGER(IntKi) :: i - REAL(R8Ki) :: RotateStates(3,3) - REAL(R8Ki), ALLOCATABLE :: RelState_x(:,:) - REAL(R8Ki), ALLOCATABLE :: RelState_xdot(:,:) + 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] - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'BD_JacobianPInput' - - - ! Initialize ErrStat + character(*), parameter :: RoutineName = 'BD_JacobianPInput' + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + REAL(R8Ki) :: RotateStates(3,3) + logical :: NeedWriteOutput + INTEGER(IntKi) :: i, j, col ErrStat = ErrID_None ErrMsg = '' + ! Get OP values here + call BD_CalcOutput(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2); if (Failed()) return - ! get OP values here: - call BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! Make a copy of the inputs to perturb + call BD_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call BD_VarsPackInput(Vars, u, m%Jac%u) - ! make a copy of the inputs to perturb - call BD_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - if (p%RelStates) then - if (.not. allocated(RelState_x)) then - call AllocAry(RelState_x, p%Jac_nx * 2, size(p%Jac_u_indx,1), 'RelState_x', ErrStat2, ErrMsg2) ! 18=6 motion fields on mesh x 3 directions for each field - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - end if - if (.not. allocated(RelState_xdot)) then - call AllocAry(RelState_xdot, size(RelState_x,1), size(RelState_x,2), 'RelState_xdot', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - end if - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + if (present(dYdu)) then - call Compute_RelState_Matrix(p, u, x, OtherState, RelState_x, RelState_xdot) - - if ( present(StateRel_x) ) then - if (.not. allocated(StateRel_x)) then - call AllocAry(StateRel_x, size(RelState_x,1), size(RelState_x,2), 'StateRel_x', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - end if - StateRel_x = RelState_x - end if - if ( present(StateRel_xdot) ) then - if (.not. allocated(StateRel_xdot)) then - call AllocAry(StateRel_xdot, size(RelState_xdot,1), size(RelState_xdot,2), 'StateRel_xdot', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - end if - StateRel_xdot = RelState_xdot - end if - else - if ( present(StateRel_x) ) then - if (allocated(StateRel_x)) deallocate(StateRel_x) - end if - if ( present(StateRel_xdot) ) then - if (allocated(StateRel_xdot)) deallocate(StateRel_xdot) + ! Allocate dYdu if not allocated + if (.not. allocated(dYdu)) then + call AllocAry(dYdu, m%Jac%Ny, m%Jac%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if - 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 + ! Determine if write outputs need to be calculated (usually at end of output variables) + NeedWriteOutput = .false. + do i = size(Vars%y), 1, -1 + if (MV_HasFlagsAll(Vars%y(i), VF_WriteOut)) then + NeedWriteOutput = .true. + exit end if - end if - - if (p%CompAeroMaps) then - dYdu = 0.0_R8Ki - else - - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call BD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call BD_CopyOutput( y, y_m, 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 BD_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 - call Perturb_u( p, i, 1, u_perturb, delta_p ) - - ! compute y at u_op + delta_p u - call BD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, 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 BD_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 - call Perturb_u( p, i, -1, u_perturb, delta_m ) - - ! compute y at u_op - delta_m u - call BD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, 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 + end do - ! get central difference: - call Compute_dY( p, y_p, y_m, delta_p, dYdu(:,i) ) - + ! Loop through input variables + do i = 1, size(Vars%u) + + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%u(i)%Num + + ! Calculate column index + col = Vars%u(i)%iLoc(1) + j - 1 + + ! Calculate positive perturbation + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call BD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call BD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput); if (Failed()) return + call BD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call BD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call BD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput); if (Failed()) return + call BD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) + + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(Vars%y, Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) end do - - - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - call BD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call BD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - if (p%RelStates) then - call BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx=m%lin_C ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - dYdu = dYdu + matmul(m%lin_C, RelState_x) - end if - - end if ! CompAeroMaps - - END IF + end do + + end if - IF ( PRESENT( dXdu ) ) THEN - ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + if (present(dXdu)) then - ! allocate dXdu if necessary + ! Allocate dXdu if not allocated if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%Jac_nx * 2, size(p%Jac_u_indx,1), 'dXdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dXdu, m%Jac%Nx, m%Jac%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return end if - - - do i=1,size(p%Jac_u_indx,1) - - ! get u_op + delta u - call BD_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 - call Perturb_u( p, i, 1, u_perturb, delta_p ) + + ! Loop through input variables + do i = 1, size(Vars%u) - ! compute x at u_op + delta u - call BD_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get u_op - delta u - call BD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - call Perturb_u( p, i, -1, u_perturb, delta_m ) - - ! compute x at u_op - delta u - call BD_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get central difference: - - ! we may have had an error allocating memory, so we'll check - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - ! get central difference: - call Compute_dX( p, x_p, x_m, delta_p, dXdu(:,i) ) - + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%u(i)%Num + + ! Calculate column index + col = Vars%u(i)%iLoc(1) + j - 1 + + ! Calculate positive perturbation + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call BD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call BD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call BD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call BD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call BD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call BD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_neg) + + ! Get partial derivative via central difference and store in full linearization array + dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%u(i)%Perturb) + end do end do - - call BD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call BD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - if (p%RelStates) then - call BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dXdx=m%lin_A ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - dXdu = dXdu + matmul(m%lin_A, RelState_x) - RelState_xdot - end if - + ! If rotate states is enabled, modify Jacobian if (p%RotStates) then ! Calculate difference between input root orientation and root reference orientation - RotateStates = matmul( u%RootMotion%Orientation(:,:,1), OtherState%GlbRot ) + RotateStates = matmul(u%RootMotion%Orientation(:,:,1), OtherState%GlbRot) do i=1,size(dXdu,1),3 - dXdu(i:i+2, :) = matmul( RotateStates, dXdu(i:i+2, :) ) + dXdu(i:i+2, :) = matmul(RotateStates, dXdu(i:i+2, :)) end do end if - END IF ! dXdu + end if + + !---------------------------------------------------------------------------- - IF ( PRESENT( dXddu ) ) THEN + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the inputs (u) here: + if (present(dXddu)) then if (allocated(dXddu)) deallocate(dXddu) - END IF + end if + + !---------------------------------------------------------------------------- - IF ( PRESENT( dZdu ) ) THEN + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the inputs (u) here: + if (present(dZdu)) then if (allocated(dZdu)) deallocate(dZdu) - END IF + end if - call cleanup() contains - subroutine cleanup() - call BD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call BD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call BD_DestroyInput( u_perturb, ErrStat2, ErrMsg2 ) - - if (allocated(RelState_x)) deallocate(RelState_x) - if (allocated(RelState_xdot)) deallocate(RelState_xdot) - end subroutine cleanup - + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function END SUBROUTINE BD_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx, StateRotation ) -!.................................................................................................................................. +SUBROUTINE BD_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx, StateRotation) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables 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) TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -6164,327 +6229,171 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, 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 - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions - !! (Y) with respect to the continuous - !! states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state - !! functions (X) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state - !! functions (Xd) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state - !! functions (Z) with respect to - !! the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions (Y) with respect to the continuous states (x) + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) with respect to the continuous states (x) + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the continuous states (x) + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) with respect to the continuous states (x) REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: StateRotation(:,:) !< Matrix by which the states are optionally rotated - - ! local variables - TYPE(BD_OutputType) :: y_p - TYPE(BD_OutputType) :: y_m - TYPE(BD_ContinuousStateType) :: x_p - TYPE(BD_ContinuousStateType) :: x_m - TYPE(BD_ContinuousStateType) :: x_perturb - INTEGER(IntKi) :: i - REAL(R8Ki) :: RotateStates(3,3) - REAL(R8Ki) :: RotateStatesTranspose(3,3) - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_JacobianPContState' - - - ! Initialize ErrStat + CHARACTER(*), PARAMETER :: RoutineName = 'BD_JacobianPContState' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + REAL(R8Ki) :: RotateStates(3,3) + REAL(R8Ki) :: RotateStatesTranspose(3,3) + INTEGER(IntKi) :: i, j, col + logical :: NeedWriteOutput ErrStat = ErrID_None ErrMsg = '' - IF ( PRESENT( dYdx ) .AND. PRESENT( dXdx )) THEN - call BD_JacobianPContState_noRotate(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2, dYdx, dXdx) -! call BD_JacobianPContState_noRotate(t, u, p, x, xd, z, OtherState, y, m, LIN_X_CALLED_FIRST, ErrStat2, ErrMsg2, dYdx, dXdx) - ELSEIF ( PRESENT( dYdx ) ) THEN - call BD_JacobianPContState_noRotate(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2, dYdx=dYdx ) -! call BD_JacobianPContState_noRotate(t, u, p, x, xd, z, OtherState, y, m, LIN_X_CALLED_FIRST, ErrStat2, ErrMsg2, dYdx=dYdx ) - ELSEIF ( PRESENT( dXdx ) ) THEN - call BD_JacobianPContState_noRotate(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2, dXdx=dXdx) -! call BD_JacobianPContState_noRotate(t, u, p, x, xd, z, OtherState, y, m, LIN_X_CALLED_FIRST, ErrStat2, ErrMsg2, dXdx=dXdx) - END IF - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! Copy state values + call BD_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call BD_VarsPackContState(Vars, x, m%Jac%x) + ! If rotate states is enabled if (p%RotStates) then ! Calculate difference between input root orientation and root reference orientation - RotateStates = matmul( u%RootMotion%Orientation(:,:,1), OtherState%GlbRot ) + RotateStates = matmul(u%RootMotion%Orientation(:,:,1), OtherState%GlbRot) RotateStatesTranspose = transpose( RotateStates ) - if ( present(StateRotation) ) then + if (present(StateRotation)) then if (.not. allocated(StateRotation)) then - call AllocAry(StateRotation, 3, 3, 'StateRotation', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(StateRotation, 3, 3, 'StateRotation', ErrStat2, ErrMsg2); if (Failed()) return end if StateRotation = RotateStates end if else - if ( present(StateRotation) ) then + if (present(StateRotation)) then if (allocated(StateRotation)) deallocate(StateRotation) end if end if - IF ( PRESENT( dYdx ) ) THEN + !---------------------------------------------------------------------------- - if (p%RotStates) then - do i=1,size(dYdx,2),3 - dYdx(:, i:i+2) = matmul( dYdx(:, i:i+2), RotateStatesTranspose ) - end do - end if - - END IF + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + if (present(dYdx)) then - IF ( PRESENT( dXdx ) ) THEN + ! Allocate dYdx if not allocated + if (.not. allocated(dYdx)) then + call AllocAry(dYdx, m%Jac%Ny, m%Jac%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return + end if - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + ! Determine if write outputs need to be calculated (usually at end of output variables) + NeedWriteOutput = .false. + do i = size(Vars%y), 1, -1 + if (MV_HasFlagsAll(Vars%y(i), VF_WriteOut)) then + NeedWriteOutput = .true. + exit + end if + end do - if (p%RotStates) then - do i=1,size(dXdx,1),3 - dXdx(i:i+2,:) = matmul( RotateStates, dXdx(i:i+2,:) ) - end do - do i=1,size(dXdx,2),3 - dXdx(:, i:i+2) = matmul( dXdx(:, i:i+2), RotateStatesTranspose ) - end do - end if - - END IF + ! Loop through state variables + do i = 1, size(Vars%x) - IF ( PRESENT( dXddx ) ) THEN - if (allocated(dXddx)) deallocate(dXddx) - END IF + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%x(i)%Num - IF ( PRESENT( dZdx ) ) THEN - if (allocated(dZdx)) deallocate(dZdx) - END IF + ! Calculate column index + col = Vars%x(i)%iLoc(1) + j - 1 - call cleanup() - -contains - subroutine cleanup() - call BD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call BD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call BD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call BD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) - call BD_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) - end subroutine cleanup + ! Calculate positive perturbation + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call BD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput); if (Failed()) return + call BD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) -END SUBROUTINE BD_JacobianPContState -!---------------------------------------------------------------------------------------------------------------------------------- -!> 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, and dX/dx are returned. -!SUBROUTINE BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, calledFrom, ErrStat, ErrMsg, dYdx, dXdx ) -SUBROUTINE BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx ) -!.................................................................................................................................. + ! Calculate negative perturbation + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call BD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call BD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, NeedWriteOutput); if (Failed()) return + call BD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) - 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) - TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(BD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(BD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(BD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(BD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(BD_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 dYdx. - TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - !INTEGER(IntKi), INTENT(IN ) :: calledFrom !< flag to help determine logic for when these matrices need to be recalculated - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions - !! (Y) with respect to the continuous - !! states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state - !! functions (X) with respect to - !! the continuous states (x) [intent in to avoid deallocation] + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(Vars%y, Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) + end do + end do + + ! If rotate state is enabled, modify Jacobian + if (p%RotStates) then + do i = 1, size(dYdx,2), 3 + dYdx(:, i:i+2) = matmul( dYdx(:, i:i+2), RotateStatesTranspose) + end do + end if + end if - ! local variables - TYPE(BD_OutputType) :: y_p - TYPE(BD_OutputType) :: y_m - TYPE(BD_ContinuousStateType) :: x_p - TYPE(BD_ContinuousStateType) :: x_m - TYPE(BD_ContinuousStateType) :: x_perturb - REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, k - INTEGER(IntKi) :: index - INTEGER(IntKi) :: dof - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_JacobianPContState_noRotate' - - - ! Initialize ErrStat + !---------------------------------------------------------------------------- - ErrStat = ErrID_None - ErrMsg = '' + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + if (present(dXdx)) then - ! make a copy of the continuous states to perturb - call BD_CopyContState( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return + ! Allocate dXdx if not allocated + if (.not. allocated(dXdx)) then + call AllocAry(dXdx, m%Jac%Nx, m%Jac%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return end if - IF ( PRESENT( dYdx ) ) THEN + ! Loop through state variables + do i = 1, size(Vars%x) - ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%x(i)%Num - ! allocate dYdx if necessary - if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Jac_ny, p%Jac_nx*2, 'dYdx', 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 BD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call BD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - - index = 1 - do k=1,2 - do i=2,p%node_total - do dof=1,p%dof_node - - ! get x_op + delta x - call BD_CopyContState( x, x_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 - call perturb_x(p, k, i, dof, 1, x_perturb, delta ) - - ! compute y at x_op + delta x - call BD_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, 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 x_op - delta x - call BD_CopyContState( x, x_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 - call perturb_x(p, k, i, dof, -1, x_perturb, delta ) - - ! compute y at x_op - delta x - call BD_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, 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, dYdx(:,index) ) - - index = index+1 - end do - end do - end do - - - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - call BD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call BD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more + ! Calculate column index + col = Vars%x(i)%iLoc(1) + j - 1 - - END IF + ! Calculate positive perturbation + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call BD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call BD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call BD_VarsPackContStateDeriv(Vars, m%dxdt_lin, m%Jac%x_pos) - IF ( PRESENT( dXdx ) ) THEN + ! Calculate negative perturbation + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call BD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call BD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call BD_VarsPackContStateDeriv(Vars, m%dxdt_lin, m%Jac%x_neg) - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + ! Get partial derivative via central difference and store in full linearization array + dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%x(i)%Perturb) + end do + end do - ! allocate dXdu if necessary - if (.not. allocated(dXdx)) then - call AllocAry(dXdx, p%Jac_nx * 2, p%Jac_nx * 2, 'dXdx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + ! If rotate state is enabled, modify Jacobian + if (p%RotStates) then + do i=1,size(dXdx,1),3 + dXdx(i:i+2,:) = matmul(RotateStates, dXdx(i:i+2,:)) + end do + do i=1,size(dXdx,2),3 + dXdx(:, i:i+2) = matmul(dXdx(:, i:i+2), RotateStatesTranspose) + end do end if - - index = 1 ! counter into dXdx - do k=1,2 ! 1=positions (x_perturb%q); 2=velocities (x_perturb%dqdt) - do i=2,p%node_total - do dof=1,p%dof_node - - ! get x_op + delta x - call BD_CopyContState( x, x_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 - call perturb_x(p, k, i, dof, 1, x_perturb, delta ) - ! compute x at x_op + delta x - call BD_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end if + !---------------------------------------------------------------------------- - ! get x_op - delta x - call BD_CopyContState( x, x_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 - call perturb_x(p, k, i, dof, -1, x_perturb, delta ) - - ! compute x at x_op - delta x - call BD_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (present(dXddx)) then + if (allocated(dXddx)) deallocate(dXddx) + end if - - ! get central difference: - - ! we may have had an error allocating memory, so we'll check - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - ! get central difference: - call Compute_dX( p, x_p, x_m, delta, dXdx(:,index) ) - - index = index+1 - end do - end do - end do - - call BD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call BD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - END IF - + !---------------------------------------------------------------------------- + + if (present(dZdx)) then + if (allocated(dZdx)) deallocate(dZdx) + end if - call cleanup() - contains - subroutine cleanup() - call BD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call BD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call BD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call BD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) - call BD_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) - end subroutine cleanup - -END SUBROUTINE BD_JacobianPContState_noRotate + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +END SUBROUTINE BD_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the discrete states (xd). The partial derivatives dY/dxd, dX/dxd, dXd/dxd, and DZ/dxd are returned. -SUBROUTINE BD_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) +SUBROUTINE BD_JacobianPDiscState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) !.................................................................................................................................. - + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(BD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -6556,9 +6465,9 @@ END SUBROUTINE BD_JacobianPDiscState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the constraint states (z). The partial derivatives dY/dz, dX/dz, dXd/dz, and DZ/dz are returned. -SUBROUTINE BD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) -!.................................................................................................................................. +SUBROUTINE BD_JacobianPConstrState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(BD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -6609,208 +6518,9 @@ SUBROUTINE BD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat IF ( PRESENT(dZdz) ) THEN END IF - 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, NeedTrimOP ) - - 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) - TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(BD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(BD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(BD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(BD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(BD_OutputType), INTENT(IN ) :: y !< Output at operating point - 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 - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - LOGICAL, OPTIONAL, INTENT(IN ) :: NeedTrimOP !< whether a y_op values should contain values for trim solution (3-value representation instead of full orientation matrices, no rotation acc) - - INTEGER(IntKi) :: index, i, dof - INTEGER(IntKi) :: nu - INTEGER(IntKi) :: ny - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_GetOP' - LOGICAL :: FieldMask(FIELDMASK_SIZE) - LOGICAL :: ReturnTrimOP - TYPE(BD_ContinuousStateType) :: dx ! derivative of continuous states at operating point - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - - IF ( PRESENT( u_op ) ) THEN - - nu = size(p%Jac_u_indx,1) + u%RootMotion%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM (thus 6 more per node) - - if (.not. allocated(u_op)) then - call AllocAry(u_op, nu, 'u_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end if - - - index = 1 - if (.not. p%CompAeroMaps) then - FieldMask = .false. - FieldMask(MASKID_TranslationDisp) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TranslationVel) = .true. - FieldMask(MASKID_RotationVel) = .true. - FieldMask(MASKID_TranslationAcc) = .true. - FieldMask(MASKID_RotationAcc) = .true. - call PackMotionMesh(u%RootMotion, u_op, index, FieldMask=FieldMask) - - call PackLoadMesh(u%PointLoad, u_op, index) - end if - - call PackLoadMesh(u%DistrLoad, u_op, index) - - END IF - - - IF ( PRESENT( y_op ) ) THEN - ! Only the y operating points need to potentially return a smaller array than the "normal" call to this return. In the trim solution, we use a smaller array for y. - if (present(NeedTrimOP)) then - ReturnTrimOP = NeedTrimOP - else - ReturnTrimOP = .false. - end if - - 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 - end if - - if (ReturnTrimOP) y_op = 0.0_ReKi ! initialize in case we are returning packed orientations and don't fill the entire array - - index = 1 - FieldMask = .false. - FieldMask(MASKID_TranslationDisp) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TranslationVel) = .true. - - if (.not. p%CompAeroMaps) then - - call PackLoadMesh(y%ReactionForce, y_op, index) - - FieldMask(MASKID_RotationVel) = .true. - FieldMask(MASKID_TranslationAcc) = .true. - FieldMask(MASKID_RotationAcc) = .true. - end if - call PackMotionMesh(y%BldMotion, y_op, index, FieldMask=FieldMask, TrimOP=ReturnTrimOP) - - if (.not. p%CompAeroMaps) then - index = index - 1 - do i=1,p%NumOuts + p%BldNd_TotNumOuts - y_op(i+index) = y%WriteOutput(i) - end do - end if - - - END IF - - IF ( PRESENT( x_op ) ) THEN - - if (.not. allocated(x_op)) then - call AllocAry(x_op, p%Jac_nx * 2,'x_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - end if - - index = 1 - do i=2,p%node_total - do dof=1,p%dof_node - x_op(index) = x%q( dof, i ) - index = index+1 - end do - end do - - do i=2,p%node_total - do dof=1,p%dof_node - x_op(index) = x%dqdt( dof, i ) - index = index+1 - end do - end do - - END IF - - IF ( PRESENT( dx_op ) ) THEN - - if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%Jac_nx * 2,'dx_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - end if - - call BD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dx, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call BD_DestroyContState( dx, ErrStat2, ErrMsg2) - return - end if - - index = 1 - do i=2,p%node_total - do dof=1,p%dof_node - dx_op(index) = dx%q( dof, i ) - index = index+1 - end do - end do - - do i=2,p%node_total - do dof=1,p%dof_node - dx_op(index) = dx%dqdt( dof, i ) - index = index+1 - end do - end do - - call BD_DestroyContState( dx, ErrStat2, ErrMsg2) - - END IF - - IF ( PRESENT( xd_op ) ) THEN - - END IF - - IF ( PRESENT( z_op ) ) THEN - ! this is a little weird, but seems to be how BD has implemented the first node in the continuous state array. - - if (.not. allocated(z_op)) then - call AllocAry(z_op, p%dof_node * 2,'z_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - end if - - index = 1 - do dof=1,p%dof_node - z_op(index) = x%q( dof, 1 ) - index = index+1 - end do - - do dof=1,p%dof_node - z_op(index) = x%dqdt( dof, 1 ) - index = index+1 - end do - - END IF -END SUBROUTINE BD_GetOP !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ @@ -6914,6 +6624,7 @@ END SUBROUTINE BD_WriteMassStiffInFirstNodeFrame !> Update the state information to follow the blade rootmotion mesh. !! - move the state information in x from the previous reference frame at time T (u(2)%rootmotion) to the new reference frame at T+dt (u(1)%rootmation) !! - the GlbRot, GlbPos, and Glb_crv values are stored as otherstates and updated +!! - subroutine BD_UpdateGlobalRef(u, p, x, OtherState, ErrStat, ErrMsg) type(BD_InputType), intent(in ) :: u !< Inputs at utimes type(BD_ParameterType), intent(in ) :: p !< Parameters @@ -6929,7 +6640,6 @@ subroutine BD_UpdateGlobalRef(u, p, x, OtherState, ErrStat, ErrMsg) real(R8Ki) :: GlbRot_old(3, 3), GlbRot_new(3, 3), GlbRot_diff(3, 3) real(R8Ki) :: NodeRot_old(3) real(R8Ki) :: GlbPos_old(3), GlbPos_new(3) - real(R8Ki) :: pos(3), rot(3), trans_vel(3), rot_vel(3), uuN0(3) integer(IntKi) :: i, j, temp_id ErrStat = ErrID_None diff --git a/modules/beamdyn/src/BeamDyn_IO.f90 b/modules/beamdyn/src/BeamDyn_IO.f90 index 0b52e2fabe..46d1404f0a 100644 --- a/modules/beamdyn/src/BeamDyn_IO.f90 +++ b/modules/beamdyn/src/BeamDyn_IO.f90 @@ -758,10 +758,6 @@ SUBROUTINE BD_ReadPrimaryFile(InputFile,InputFileData,OutFileRoot,UnEc,ErrStat,E CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF if (InputFileData%tngt_stf_fd) CALL WrScr( 'Using finite difference to compute tangent stiffness matrix'//NewLine ) - ! ! RelStates - Define states relative to root motion during linearization? (flag) [used only when linearizing] - !CALL ReadVar(UnIn,InputFile,InputFileData%RelStates,"RelStates", "Define states relative to root motion during linearization? (flag) [used only when linearizing]",ErrStat2,ErrMsg2,UnEc) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - InputFileData%RelStates = .false. ! this doesn't seem to be needed anymore (and I think there is a problem with using it in MBC3) Line = "" CALL ReadVar(UnIn, InputFile, Line, 'tngt_stf_comp','compare tangent stiffness using finite difference flag', ErrStat2, ErrMsg2, UnEc) @@ -2058,613 +2054,6 @@ SUBROUTINE BD_PrintSum( p, x, OtherState, m, InitInp, ErrStat, ErrMsg ) RETURN END SUBROUTINE BD_PrintSum -!---------------------------------------------------------------------------------------------------------------------------------- - -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> This routine initializes the array that maps rows/columns of the Jacobian to specific mesh fields. -!! Do not change the order of this packing without changing subroutine ! -SUBROUTINE Init_Jacobian( p, u, y, m, InitOut, ErrStat, ErrMsg) - - TYPE(BD_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(BD_InputType) , INTENT(IN ) :: u !< inputs - TYPE(BD_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(BD_MiscVarType) , INTENT(INOUT) :: m !< misc var data - TYPE(BD_InitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) - - 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 = 'Init_Jacobian' - - ! local variables: - INTEGER(IntKi) :: i, j, index, nu, i_meshField - REAL(R8Ki) :: perturb, perturb_b - REAL(R8Ki) :: MaxThrust, MaxTorque - CHARACTER(1), PARAMETER :: UVW(3) = (/'U','V','W'/) - - - - ErrStat = ErrID_None - ErrMsg = "" - - call Init_Jacobian_y( p, y, InitOut, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call Init_Jacobian_x_z( p, InitOut, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - ! determine how many inputs there are in the Jacobians - if (p%CompAeroMaps) then - nu = u%DistrLoad%NNodes * 6 ! 3 forces + 3 moments at each node - else - nu = u%RootMotion%NNodes * 18 & ! 3 Translation Displacements + 3 orientations + 6 velocities (rotation+translation) + 6 accelerations at each node - + u%PointLoad%NNodes * 6 & ! 3 forces + 3 moments at each node - + u%DistrLoad%NNodes * 6 ! 3 forces + 3 moments at each node - end if - - ! all other inputs (e.g., hub motion) ignored - - !............................ - ! fill matrix to store index to help us figure out what the ith value of the u vector really means - ! (see beamdyn::perturb_u ... these MUST match ) - ! column 1 indicates module's mesh and field - ! column 2 indicates the first index (x-y-z component) of the field - ! column 3 is the node - !............................ - - call allocAry( p%Jac_u_indx, nu, 3, 'p%Jac_u_indx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - !............... - ! BD input mappings stored in p%Jac_u_indx: - !............... - index = 1 - !Module/Mesh/Field: u%RootMotion%TranslationDisp = 1; - !Module/Mesh/Field: u%RootMotion%Orientation = 2; - !Module/Mesh/Field: u%RootMotion%TranslationVel = 3; - !Module/Mesh/Field: u%RootMotion%RotationVel = 4; - !Module/Mesh/Field: u%RootMotion%TranslationAcc = 5; - !Module/Mesh/Field: u%RootMotion%RotationAcc = 6; - if (.not. p%CompAeroMaps) then - do i_meshField = 1,6 - do i=1,u%RootMotion%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - !Module/Mesh/Field: u%PointLoad%Force = 7; - !Module/Mesh/Field: u%PointLoad%Moment = 8; - do i_meshField = 7,8 - do i=1,u%PointLoad%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - end if - - !Module/Mesh/Field: u%DistrLoad%Force = 9; - !Module/Mesh/Field: u%DistrLoad%Moment = 10; - do i_meshField = 9,10 - do i=1,u%DistrLoad%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do !i_meshField - - - - !...................................... - ! default perturbations, p%du: - !...................................... - call allocAry( p%du, 10, 'p%du', ErrStat2, ErrMsg2) ! 10 = number of unique values in p%Jac_u_indx(:,1) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - perturb = 0.2_R8Ki*D2R_D - perturb_b = 0.2_R8Ki*D2R_D * p%blade_length - - MaxThrust = 170.0_R8Ki*p%blade_length**2 - MaxTorque = 14.0_R8Ki*p%blade_length**3 - - p%du( 1) = perturb_b ! u%RootMotion%TranslationDisp = 1; - p%du( 2) = perturb ! u%RootMotion%Orientation = 2; - p%du( 3) = perturb_b ! u%RootMotion%TranslationVel = 3; - p%du( 4) = perturb ! u%RootMotion%RotationVel = 4; - p%du( 5) = perturb_b ! u%RootMotion%TranslationAcc = 5; - p%du( 6) = perturb ! u%RootMotion%RotationAcc = 6; - - p%du( 7) = MaxThrust / (100.0_R8Ki * 3.0_R8Ki * u%PointLoad%NNodes ) ! u%PointLoad%Force = 7; - p%du( 8) = MaxTorque / (100.0_R8Ki * 3.0_R8Ki * u%PointLoad%NNodes ) ! u%PointLoad%Moment = 8; - - p%du( 9) = MaxThrust / (100.0_R8Ki * 3.0_R8Ki * u%DistrLoad%NNodes ) ! u%DistrLoad%Force = 9; - p%du(10) = MaxTorque / (100.0_R8Ki * 3.0_R8Ki * u%DistrLoad%NNodes ) ! u%DistrLoad%Moment =10; - - !..................... - ! get names of linearized inputs - !..................... - call AllocAry(InitOut%LinNames_u, nu, 'LinNames_u', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%RotFrame_u, nu, 'RotFrame_u', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%IsLoad_u, nu, 'IsLoad_u', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - InitOut%RotFrame_u = .false. ! every input is on a mesh, which stores values in the global (not rotating) frame - - index = 1 - InitOut%IsLoad_u = .true. ! initialize all inputs as loads, and overwrite for the RootMotion mesh, below: - if (.not. p%CompAeroMaps) then - call PackMotionMesh_Names(u%RootMotion, 'RootMotion', InitOut%LinNames_u, index) ! all 6 motion fields - InitOut%IsLoad_u(1:index-1) = .false. ! the RootMotion inputs are not loads - call PackLoadMesh_Names( u%PointLoad, 'PointLoad', InitOut%LinNames_u, index) - end if - call PackLoadMesh_Names( u%DistrLoad, 'DistrLoad', InitOut%LinNames_u, index) - - -END SUBROUTINE Init_Jacobian -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the Jacobian parameters and initialization outputs for the linearized outputs. -SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) - - TYPE(BD_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(BD_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(BD_InitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) - - 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 - INTEGER(IntKi) :: j - INTEGER(IntKi) :: index_next - LOGICAL :: AllOut(MaxOutPts) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Init_Jacobian_y' - - CHARACTER(ChanLen) :: ChannelName - LOGICAL :: isRotating - LOGICAL :: BladeMask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing - - ErrStat = ErrID_None - ErrMsg = "" - - if (p%CompAeroMaps) then - p%Jac_ny = y%BldMotion%NNodes * 12 ! 6 displacements (translation, rotation) + 6 velocities - else - - ! 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 + p%BldNd_TotNumOuts ! WriteOutput values - end if - - ! get the names of the linearized outputs: - call AllocAry(InitOut%LinNames_y, p%Jac_ny,'LinNames_y',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(InitOut%RotFrame_y, p%Jac_ny,'RotFrame_y',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return - - - InitOut%RotFrame_y = .false. ! need to set all the values in the global system to .false - - index_next = 1 - if (p%CompAeroMaps) then - BladeMask = .true. ! default is all the fields - BladeMask(MASKID_TRANSLATIONACC) = .false. - BladeMask(MASKID_ROTATIONACC) = .false. - - call PackMotionMesh_Names(y%BldMotion, 'Blade motion', InitOut%LinNames_y, index_next, FieldMask=BladeMask) - else - 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 + p%BldNd_TotNumOuts - InitOut%LinNames_y(i+index_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) - end do - - AllOut = .true. ! all output values except those specifically in the global system are in the rotating system - AllOut(TipTVXg) = .false. - AllOut(TipTVYg) = .false. - AllOut(TipTVZg) = .false. - AllOut(TipRVXg) = .false. - AllOut(TipRVYg) = .false. - AllOut(TipRVZg) = .false. - - do j=1,9 - do i=1,3 !x,y,z - AllOut(NTVg(j,i)) = .false. - AllOut(NRVg(j,i)) = .false. - end do - end do - - do i=1,p%NumOuts - if (p%OutParam(i)%Indx == 0 ) then - InitOut%RotFrame_y(i+index_next-1) = .false. - else - 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 if - - -END SUBROUTINE Init_Jacobian_y -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the Jacobian parameters and initialization outputs for the linearized continuous states. -SUBROUTINE Init_Jacobian_x_z( p, InitOut, ErrStat, ErrMsg) - - TYPE(BD_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(BD_InitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine - - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Init_Jacobian_x' - CHARACTER(200) :: Describe - - ! local variables: - INTEGER(IntKi) :: i - INTEGER(IntKi) :: indx - - ErrStat = ErrID_None - ErrMsg = "" - - p%Jac_nx = p%dof_node * (p%node_total-1) ! the first node is actually a constraint state - - ! allocate space for the row/column names and for perturbation sizes - !call allocAry(p%dx, p%dof_node*(p%node_total-1), 'p%dx', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%LinNames_x, p%Jac_nx*2, 'LinNames_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%RotFrame_x, p%Jac_nx*2, 'RotFrame_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%DerivOrder_x, p%Jac_nx*2, 'DerivOrder_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - !CALL AllocAry(InitOut%LinNames_z, p%dof_node*2, 'LinNames_z', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - !CALL AllocAry(InitOut%RotFrame_z, p%dof_node*2, 'RotFrame_z', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - - !...................................... - ! default perturbations, p%dx: - !...................................... - p%dx(1:3) = 0.2_BDKi*D2R_D * p%blade_length ! deflection states in m and m/s - p%dx(4:6) = 0.2_BDKi*D2R_D ! deflection states in rad and rad/s - - InitOut%RotFrame_x = p%RotStates - InitOut%DerivOrder_x = 2 - - !...................................... - ! set linearization output names: - !...................................... - indx = 1 - DO i=2, p%node_total - Describe = 'finite element node '//trim(num2lstr(i))//' (number of elements = '//trim(num2lstr(p%elem_total))//'; element order = '//trim(num2lstr(p%nodes_per_elem-1))//')' - InitOut%LinNames_x(indx) = trim(Describe)//' translational displacement in X, m' - indx = indx + 1 - InitOut%LinNames_x(indx) = trim(Describe)//' translational displacement in Y, m' - indx = indx + 1 - InitOut%LinNames_x(indx) = trim(Describe)//' translational displacement in Z, m' - indx = indx + 1 - InitOut%LinNames_x(indx) = trim(Describe)//' rotational displacement in X, rad' - indx = indx + 1 - InitOut%LinNames_x(indx) = trim(Describe)//' rotational displacement in Y, rad' - indx = indx + 1 - InitOut%LinNames_x(indx) = trim(Describe)//' rotational displacement in Z, rad' - indx = indx + 1 - END DO - - do i=1,p%Jac_nx - InitOut%LinNames_x(i+p%Jac_nx) = 'First time derivative of '//trim(InitOut%LinNames_x(i))//'/s' - InitOut%RotFrame_x(i+p%Jac_nx) = InitOut%RotFrame_x(i) - end do - - - !InitOut%RotFrame_z = .true. - !InitOut%LinNames_z(1) = 'Node 1 translational displacement in X, m' - !InitOut%LinNames_z(2) = 'Node 1 translational displacement in Y, m' - !InitOut%LinNames_z(3) = 'Node 1 translational displacement in Z, m' - !InitOut%LinNames_z(4) = 'Node 1 rotational displacement in X, -' - !InitOut%LinNames_z(5) = 'Node 1 rotational displacement in Y, -' - !InitOut%LinNames_z(6) = 'Node 1 rotational displacement in Z, -' - ! - !do i=1,6 - ! InitOut%LinNames_x(i+6) = 'First time derivative of '//trim(InitOut%LinNames_z(i))//'/s' - !end do - - -END SUBROUTINE Init_Jacobian_x_z -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine beamdyn::init_jacobian is consistant with this routine! -SUBROUTINE Perturb_u( p, n, perturb_sign, u, du ) - - TYPE(BD_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(BD_InputType) , INTENT(INOUT) :: u !< perturbed BD inputs - REAL( R8Ki ) , INTENT( OUT) :: du !< amount that specific input was perturbed - - - ! local variables - INTEGER :: fieldIndx - INTEGER :: node - - fieldIndx = p%Jac_u_indx(n,2) - node = p%Jac_u_indx(n,3) - - du = p%du( p%Jac_u_indx(n,1) ) - - ! determine which mesh we're trying to perturb and perturb the input: - SELECT CASE( p%Jac_u_indx(n,1) ) - - CASE ( 1) !Module/Mesh/Field: u%RootMotion%TranslationDisp = 1; - u%RootMotion%TranslationDisp( fieldIndx,node) = u%RootMotion%TranslationDisp( fieldIndx,node) + du * perturb_sign - CASE ( 2) !Module/Mesh/Field: u%RootMotion%Orientation = 2; - CALL PerturbOrientationMatrix( u%RootMotion%Orientation(:,:,node), du * perturb_sign, fieldIndx ) ! NOTE: call not using DCM_logmap - CASE ( 3) !Module/Mesh/Field: u%RootMotion%TranslationVel = 3; - u%RootMotion%TranslationVel( fieldIndx,node) = u%RootMotion%TranslationVel( fieldIndx,node) + du * perturb_sign - CASE ( 4) !Module/Mesh/Field: u%RootMotion%RotationVel = 4; - u%RootMotion%RotationVel(fieldIndx,node) = u%RootMotion%RotationVel(fieldIndx,node) + du * perturb_sign - CASE ( 5) !Module/Mesh/Field: u%RootMotion%TranslationAcc = 5; - u%RootMotion%TranslationAcc( fieldIndx,node) = u%RootMotion%TranslationAcc( fieldIndx,node) + du * perturb_sign - CASE ( 6) !Module/Mesh/Field: u%RootMotion%RotationAcc = 6; - u%RootMotion%RotationAcc(fieldIndx,node) = u%RootMotion%RotationAcc(fieldIndx,node) + du * perturb_sign - - CASE ( 7) !Module/Mesh/Field: u%PointLoad%Force = 7; - u%PointLoad%Force(fieldIndx,node) = u%PointLoad%Force(fieldIndx,node) + du * perturb_sign - CASE ( 8) !Module/Mesh/Field: u%PointLoad%Moment = 8; - u%PointLoad%Moment(fieldIndx,node) = u%PointLoad%Moment(fieldIndx,node) + du * perturb_sign - - CASE ( 9) !Module/Mesh/Field: u%DistrLoad%Force = 9; - u%DistrLoad%Force( fieldIndx,node) = u%DistrLoad%Force( fieldIndx,node) + du * perturb_sign - CASE (10) !Module/Mesh/Field: u%DistrLoad%Moment = 10; - u%DistrLoad%Moment(fieldIndx,node) = u%DistrLoad%Moment(fieldIndx,node) + du * perturb_sign - - END SELECT - -END SUBROUTINE Perturb_u -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine beamdyn::init_jacobian is consistant with this routine! -SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) - - TYPE(BD_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(BD_OutputType) , INTENT(IN ) :: y_p !< BD outputs at \f$ u + \Delta_p u \f$ or \f$ z + \Delta_p z \f$ (p=plus) - TYPE(BD_OutputType) , INTENT(IN ) :: y_m !< BD outputs at \f$ u - \Delta_m u \f$ or \f$ z - \Delta_m z \f$ (m=minus) - REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta_p = \Delta_p u \f$ or \f$ delta_p = \Delta_p x \f$ - REAL(R8Ki) , INTENT(INOUT) :: dY(:) !< column of dYdu or dYdx: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial z_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ - - ! local variables: - INTEGER(IntKi) :: i ! loop over outputs - INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled - LOGICAL :: Mask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing - - indx_first = 1 - if (p%CompAeroMaps) then - Mask = .true. - Mask(MASKID_TRANSLATIONACC) = .false. - Mask(MASKID_ROTATIONACC) = .false. - call PackMotionMesh_dY(y_p%BldMotion, y_m%BldMotion, dY, indx_first, FieldMask=Mask) ! 4 motion fields - else - 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 + p%BldNd_TotNumOuts - dY(i+indx_first-1) = y_p%WriteOutput(i) - y_m%WriteOutput(i) - end do - end if - - - dY = dY / (2.0_R8Ki*delta) - -END SUBROUTINE Compute_dY -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the x array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine beamdyn::init_jacobian is consistant with this routine! -SUBROUTINE Perturb_x( p, fieldIndx, node, dof, perturb_sign, x, dx ) - - TYPE(BD_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: fieldIndx !< field in the state type: 1=displacements; 2=velocities - INTEGER( IntKi ) , INTENT(IN ) :: node !< node number - INTEGER( IntKi ) , INTENT(IN ) :: dof !< dof for this perturbation - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(BD_ContinuousStateType) , INTENT(INOUT) :: x !< perturbed BD states - REAL( R8Ki ) , INTENT( OUT) :: dx !< amount that specific state was perturbed - - - ! local variables - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - REAL(R8Ki) :: orientation(3,3) - REAL(R8Ki) :: rotation(3,3) - REAL(R8Ki) :: CrvPerturb(3), CrvBase(3) - - dx = p%dx(dof) - - if (fieldIndx==1) then - if (dof < 4) then ! translational displacement - x%q( dof, node ) = x%q( dof, node ) + dx * perturb_sign - else ! w-m parameters - - ! Calculate perturbation in WM parameters - CrvPerturb = 0.0_R8Ki - CrvPerturb(dof-3) = 4.0_R8Ki * tan(dx * perturb_sign / 4.0_R8Ki) - - ! Get base rotation in WM parameters - CrvBase = x%q(4:6, node) - - ! Compose pertubation and base rotation and store in state - call BD_CrvCompose(x%q(4:6, node), CrvPerturb, CrvBase, FLAG_R1R2) - end if - else - x%dqdt( dof, node ) = x%dqdt( dof, node ) + dx * perturb_sign - end if - - -END SUBROUTINE Perturb_x -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine beamdyn::init_jacobian is consistant with this routine! -SUBROUTINE Compute_dX(p, x_p, x_m, delta, dX) - - TYPE(BD_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(BD_ContinuousStateType) , INTENT(IN ) :: x_p !< BD continuous states at \f$ u + \Delta_p u \f$ or \f$ x + \Delta_p x \f$ (p=plus) - TYPE(BD_ContinuousStateType) , INTENT(IN ) :: x_m !< BD continuous states at \f$ u - \Delta_m u \f$ or \f$ x - \Delta_m x \f$ (m=minus) - REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta_p = \Delta_p u \f$ or \f$ delta_p = \Delta_p x \f$ - REAL(R8Ki) , INTENT(INOUT) :: dX(:) !< column of dXdu or dXdx: \f$ \frac{\partial X}{\partial u_i} = \frac{x_p - x_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial X}{\partial x_i} = \frac{x_p - x_m}{2 \, \Delta x}\f$ - - ! local variables: - INTEGER(IntKi) :: i ! loop over nodes - INTEGER(IntKi) :: dof ! loop over dofs - INTEGER(IntKi) :: index ! index indicating next value of dX to be filled - - index = 1 - do i=2,p%node_total - do dof=1,p%dof_node - dX(index) = x_p%q( dof, i ) - x_m%q( dof, i ) - index = index+1 - end do - end do - - do i=2,p%node_total - do dof=1,p%dof_node - dX(index) = x_p%dqdt( dof, i ) - x_m%dqdt( dof, i ) - index = index+1 - end do - end do - - dX = dX / ( 2.0_R8Ki*delta) - -END SUBROUTINE Compute_dX -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine beamdyn::init_jacobian is consistant with this routine! -SUBROUTINE Compute_RelState_Matrix(p, u, x, OtherState, RelState_x, RelState_xdot) - - TYPE(BD_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(BD_InputType) , INTENT(IN ) :: u !< BD inputs - TYPE(BD_ContinuousStateType) , INTENT(IN ) :: x !< BD continuous states - TYPE(BD_OtherStateType) , INTENT(IN ) :: OtherState !< Other states at t - REAL(R8Ki) , INTENT(INOUT) :: RelState_x(:,:) !< - REAL(R8Ki) , INTENT(INOUT) :: RelState_xdot(:,:) !< - - ! local variables: - INTEGER(IntKi) :: i ! loop counter - INTEGER(IntKi) :: j ! loop counter - INTEGER(IntKi) :: dof ! loop over dofs - INTEGER(IntKi) :: q_index ! index into the state arrays - INTEGER(IntKi) :: dqdt_index ! index into the state arrays - INTEGER(IntKi) :: node ! node in the state arrays - - REAL(R8Ki) :: dp ! temporary dot product - REAL(R8Ki) :: cp(3) ! temporary cross product - REAL(R8Ki) :: RotVel(3) ! temporary velocity - REAL(R8Ki) :: RotAcc(3) ! temporary acceleration - REAL(R8Ki) :: DisplacedPosition(3) - REAL(R8Ki) :: fx_p(3,3) - - RelState_x = 0.0_ReKi - RelState_xdot = 0.0_ReKi - - !----------------------------------- - do i=1,p%elem_total - do j=2,p%nodes_per_elem - - node = (i-1)*(p%nodes_per_elem-1) + j ! index to state array (rows of conversion matrices) - q_index = (node - 2)*p%dof_node + 1 ! index into displacement portion of x (skipping node 1) - dqdt_index = p%Jac_nx + q_index - - DisplacedPosition = u%RootMotion%Position(:,1) + u%RootMotion%TranslationDisp(:,1) & - - OtherState%GlbPos - MATMUL(OtherState%GlbRot, p%uuN0(1:3,j,i) + x%q(1:3,node) ) - - RotVel = real(u%RootMotion%RotationVel(:,1),R8Ki) - RotAcc = real(u%RootMotion%RotationAcc(:,1),R8Ki) - - fx_p = SkewSymMat(DisplacedPosition) - - do dof=0,5 - RelState_x( q_index+dof, 1+dof ) = 1.0_R8Ki ! root displacements to node displacements - end do - do dof=0,5 - RelState_x( dqdt_index+dof, 7+dof ) = 1.0_R8Ki ! root velocities to node velocities - end do - - - RelState_x( q_index:q_index+2, 4: 6 ) = fx_p ! root rotational displacement to node translational displacement - RelState_x( dqdt_index:dqdt_index+2, 10:12 ) = fx_p ! root rotational velocity to node translational velocity - - ! root rotational displacement to node translational velocity: - RelState_x( dqdt_index:dqdt_index+2, 4:6 ) = OuterProduct( DisplacedPosition, RotVel ) - dp = dot_product( DisplacedPosition, RotVel ) - do dof=0,2 - RelState_x( dqdt_index+dof, 4+dof ) = RelState_x( dqdt_index+dof, 4+dof ) - dp ! root rotational displacement to node translational velocity - end do - !---------- - - - !............................................. - ! The first p%Jac_nx rows of RelState_xdot are the same as the last p%Jac_nx rows of RelState_x, so I'm not going to recalculate these rows, we'll set them after the loops: - !do dof=0,5 - ! RelState_xdot( q_index+dof, 7+dof ) = 1.0_ReKi ! root velocities to node velocities - !end do - !RelState_xdot( q_index:q_index+2, 4:6 ) = RelState_x( dqdt_index:dqdt_index+2, 4:6 ) ! root rotational displacement to node translational velocity - !RelState_xdot( q_index:q_index+2, 10:12 ) = fx_p ! root rotational velocity to node translational velocity - - do dof=0,5 - RelState_xdot( dqdt_index+dof, 13+dof ) = 1.0_R8Ki ! root accelerations to node accelerations - end do - - - ! root translational velocity to node translational acceleration: - cp = cross_product(u%RootMotion%RotationVel(:,1), DisplacedPosition) - RelState_xdot( dqdt_index:dqdt_index+2, 7:9 ) = OuterProduct( DisplacedPosition, RotAcc ) & - + OuterProduct( cp, RotVel ) - dp*SkewSymMat(RotVel) - dp = dot_product( DisplacedPosition, RotAcc ) - do dof=0,2 - RelState_xdot( dqdt_index+dof, 7+dof ) = RelState_xdot( dqdt_index+dof, 7+dof ) - dp - end do - !----------- - - RelState_xdot( dqdt_index:dqdt_index+2, 10:12 ) = RelState_x( dqdt_index:dqdt_index+2, 4:6 ) + SkewSymMat(cp) ! root rotational velocity to node translational acceleration - RelState_xdot( dqdt_index:dqdt_index+2, 16:18 ) = fx_p ! root rotational acceleration to node translational acceleration - - end do - end do - RelState_xdot(1:p%Jac_nx,:) = RelState_x(p%Jac_nx+1:,:) - -END SUBROUTINE Compute_RelState_Matrix -!---------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------- END MODULE BeamDyn_IO diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 81632c30ff..aec9b4bd05 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -33,12 +33,12 @@ MODULE BeamDyn_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: BD_STATIC_ANALYSIS = 1 ! Constant for static analysis. InputType%Dynamic = FALSE. [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BD_DYNAMIC_ANALYSIS = 2 ! Constant for dynamic analysis. InputType%Dynamic = TRUE .AND. BD_InputFile%QuasiStaticSolve = FALSE [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BD_DYN_SSS_ANALYSIS = 3 ! Constant for dynamic analysis with Steady State Startup solve. InputType%Dynamic = TRUE .AND. BD_InputFile%QuasiStaticSolve = TRUE [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BD_MESH_FE = 1 ! Constant for creating y%BldMotion at the FE (GLL) nodes [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BD_MESH_QP = 2 ! Constant for creating y%BldMotion at the quadrature nodes [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BD_MESH_STATIONS = 3 ! Constant for creating y%BldMotion at the blade property input stations [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BD_STATIC_ANALYSIS = 1 ! Constant for static analysis. InputType%Dynamic = FALSE. [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BD_DYNAMIC_ANALYSIS = 2 ! Constant for dynamic analysis. InputType%Dynamic = TRUE .AND. BD_InputFile%QuasiStaticSolve = FALSE [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BD_DYN_SSS_ANALYSIS = 3 ! Constant for dynamic analysis with Steady State Startup solve. InputType%Dynamic = TRUE .AND. BD_InputFile%QuasiStaticSolve = TRUE [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BD_MESH_FE = 1 ! Constant for creating y%BldMotion at the FE (GLL) nodes [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BD_MESH_QP = 2 ! Constant for creating y%BldMotion at the quadrature nodes [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BD_MESH_STATIONS = 3 ! Constant for creating y%BldMotion at the blade property input stations [-] ! ========= BD_InitInputType ======= TYPE, PUBLIC :: BD_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] @@ -61,6 +61,7 @@ MODULE BeamDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] 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 [-] @@ -108,7 +109,6 @@ MODULE BeamDyn_Types REAL(R8Ki) :: pitchC = 0.0_R8Ki !< Pitch actuator damping [-] LOGICAL :: Echo = .false. !< Echo [-] LOGICAL :: RotStates = .TRUE. !< Orient states in rotating frame during linearization? (flag) [-] - LOGICAL :: RelStates = .FALSE. !< Define states relative to root motion during linearization? (flag) [-] LOGICAL :: tngt_stf_fd = .false. !< Flag to compute tangent stifness matrix via finite difference [-] LOGICAL :: tngt_stf_comp = .false. !< Flag to compare finite differenced and analytical tangent stifness [-] INTEGER(IntKi) :: NNodeOuts = 0_IntKi !< Number of node outputs [0 - 9] [-] @@ -159,6 +159,7 @@ MODULE BeamDyn_Types ! ======================= ! ========= BD_ParameterType ======= TYPE, PUBLIC :: BD_ParameterType + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] REAL(DbKi) :: dt = 0.0_R8Ki !< module dt [s] REAL(DbKi) , DIMENSION(1:9) :: coef = 0.0_R8Ki !< GA2 Coefficient [-] REAL(DbKi) :: rhoinf = 0.0_R8Ki !< Numerical Damping Coefficient for GA2 [-] @@ -229,13 +230,7 @@ MODULE BeamDyn_Types REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: QPtw_Shp_Jac !< optimization variable: QPtw_Shp_Jac(idx_qp,i,nelem) = p%Shp(i,idx_qp)*p%QPtWeight(idx_qp)*p%Jacobian(idx_qp,nelem) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: QPtw_ShpDer !< optimization variable: QPtw_ShpDer(idx_qp,i) = p%ShpDer(i,idx_qp)*p%QPtWeight(idx_qp) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: FEweight !< weighting factors for integrating local sectional loads [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] - REAL(R8Ki) , DIMENSION(1:6) :: dx = 0.0_R8Ki !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] - INTEGER(IntKi) :: Jac_nx = 0_IntKi !< half the number of continuous states in jacobian matrix [-] LOGICAL :: RotStates = .false. !< Orient states in rotating frame during linearization? (flag) [-] - LOGICAL :: RelStates = .false. !< Define states relative to root motion during linearization? (flag) [-] LOGICAL :: CompAeroMaps = .FALSE. !< flag to determine if BeamDyn is computing aero maps (true) or running a normal simulation (false) [-] END TYPE BD_ParameterType ! ======================= @@ -331,9 +326,27 @@ MODULE BeamDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: LP_indx !< Index vector for LU [-] TYPE(BD_InputType) :: u !< Inputs converted to the internal BD coordinate system [-] TYPE(BD_InputType) :: u2 !< Inputs in the FAST coordinate system, possibly modified by pitch actuator [-] + TYPE(ModJacType) :: Jac !< Jacobian matrices and arrays corresponding to module variables [-] + TYPE(BD_ContinuousStateType) :: x_perturb !< [-] + TYPE(BD_ContinuousStateType) :: dxdt_lin !< [-] + TYPE(BD_InputType) :: u_perturb !< [-] + TYPE(BD_OutputType) :: y_lin !< [-] END TYPE BD_MiscVarType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: BD_x_q = 1 ! BD%q + integer(IntKi), public, parameter :: BD_x_dqdt = 2 ! BD%dqdt + integer(IntKi), public, parameter :: BD_z_DummyConstrState = 3 ! BD%DummyConstrState + integer(IntKi), public, parameter :: BD_u_RootMotion = 4 ! BD%RootMotion + integer(IntKi), public, parameter :: BD_u_PointLoad = 5 ! BD%PointLoad + integer(IntKi), public, parameter :: BD_u_DistrLoad = 6 ! BD%DistrLoad + integer(IntKi), public, parameter :: BD_u_HubMotion = 7 ! BD%HubMotion + integer(IntKi), public, parameter :: BD_y_ReactionForce = 8 ! BD%ReactionForce + integer(IntKi), public, parameter :: BD_y_BldMotion = 9 ! BD%BldMotion + integer(IntKi), public, parameter :: BD_y_RootMxr = 10 ! BD%RootMxr + integer(IntKi), public, parameter :: BD_y_RootMyr = 11 ! BD%RootMyr + integer(IntKi), public, parameter :: BD_y_WriteOutput = 12 ! BD%WriteOutput + +contains subroutine BD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(BD_InitInputType), intent(in) :: SrcInitInputData @@ -448,6 +461,7 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + DstInitOutputData%Vars => SrcInitOutputData%Vars if (allocated(SrcInitOutputData%LinNames_y)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_y) UB(1:1) = ubound(SrcInitOutputData%LinNames_y) @@ -563,6 +577,7 @@ subroutine BD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitOutputData%Vars) if (allocated(InitOutputData%LinNames_y)) then deallocate(InitOutputData%LinNames_y) end if @@ -593,10 +608,18 @@ subroutine BD_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(BD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackInitOutput' + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if call RegPackAlloc(RF, InData%LinNames_y) call RegPackAlloc(RF, InData%LinNames_x) call RegPackAlloc(RF, InData%LinNames_u) @@ -615,10 +638,30 @@ subroutine BD_UnPackInitOutput(RF, OutData) integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LinNames_x); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return @@ -792,7 +835,6 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%pitchC = SrcInputFileData%pitchC DstInputFileData%Echo = SrcInputFileData%Echo DstInputFileData%RotStates = SrcInputFileData%RotStates - DstInputFileData%RelStates = SrcInputFileData%RelStates DstInputFileData%tngt_stf_fd = SrcInputFileData%tngt_stf_fd DstInputFileData%tngt_stf_comp = SrcInputFileData%tngt_stf_comp DstInputFileData%NNodeOuts = SrcInputFileData%NNodeOuts @@ -897,7 +939,6 @@ subroutine BD_PackInputFile(RF, Indata) call RegPack(RF, InData%pitchC) call RegPack(RF, InData%Echo) call RegPack(RF, InData%RotStates) - call RegPack(RF, InData%RelStates) call RegPack(RF, InData%tngt_stf_fd) call RegPack(RF, InData%tngt_stf_comp) call RegPack(RF, InData%NNodeOuts) @@ -945,7 +986,6 @@ subroutine BD_UnPackInputFile(RF, OutData) call RegUnpack(RF, OutData%pitchC); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Echo); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%RotStates); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RelStates); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%tngt_stf_fd); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%tngt_stf_comp); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NNodeOuts); if (RegCheckErr(RF, RoutineName)) return @@ -1289,6 +1329,18 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'BD_CopyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if DstParamData%dt = SrcParamData%dt DstParamData%coef = SrcParamData%coef DstParamData%rhoinf = SrcParamData%rhoinf @@ -1655,35 +1707,7 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%FEweight = SrcParamData%FEweight end if - if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx) - UB(1:2) = ubound(SrcParamData%Jac_u_indx) - if (.not. allocated(DstParamData%Jac_u_indx)) then - allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx - end if - if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du) - UB(1:1) = ubound(SrcParamData%du) - if (.not. allocated(DstParamData%du)) then - allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%du = SrcParamData%du - end if - DstParamData%dx = SrcParamData%dx - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%Jac_nx = SrcParamData%Jac_nx DstParamData%RotStates = SrcParamData%RotStates - DstParamData%RelStates = SrcParamData%RelStates DstParamData%CompAeroMaps = SrcParamData%CompAeroMaps end subroutine @@ -1698,6 +1722,12 @@ subroutine BD_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'BD_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if if (allocated(ParamData%uuN0)) then deallocate(ParamData%uuN0) end if @@ -1790,12 +1820,6 @@ subroutine BD_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%FEweight)) then deallocate(ParamData%FEweight) end if - if (allocated(ParamData%Jac_u_indx)) then - deallocate(ParamData%Jac_u_indx) - end if - if (allocated(ParamData%du)) then - deallocate(ParamData%du) - end if end subroutine subroutine BD_PackParam(RF, Indata) @@ -1804,7 +1828,15 @@ subroutine BD_PackParam(RF, Indata) character(*), parameter :: RoutineName = 'BD_PackParam' integer(B4Ki) :: i1, i2, i3, i4 integer(B4Ki) :: LB(4), UB(4) + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if call RegPack(RF, InData%dt) call RegPack(RF, InData%coef) call RegPack(RF, InData%rhoinf) @@ -1891,13 +1923,7 @@ subroutine BD_PackParam(RF, Indata) call RegPackAlloc(RF, InData%QPtw_Shp_Jac) call RegPackAlloc(RF, InData%QPtw_ShpDer) call RegPackAlloc(RF, InData%FEweight) - call RegPackAlloc(RF, InData%Jac_u_indx) - call RegPackAlloc(RF, InData%du) - call RegPack(RF, InData%dx) - call RegPack(RF, InData%Jac_ny) - call RegPack(RF, InData%Jac_nx) call RegPack(RF, InData%RotStates) - call RegPack(RF, InData%RelStates) call RegPack(RF, InData%CompAeroMaps) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1910,7 +1936,27 @@ subroutine BD_UnPackParam(RF, OutData) integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if call RegUnpack(RF, OutData%dt); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%coef); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%rhoinf); if (RegCheckErr(RF, RoutineName)) return @@ -2005,13 +2051,7 @@ subroutine BD_UnPackParam(RF, OutData) call RegUnpackAlloc(RF, OutData%QPtw_Shp_Jac); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%QPtw_ShpDer); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%FEweight); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_nx); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%RotStates); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RelStates); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -3123,6 +3163,21 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call BD_CopyInput(SrcMiscData%u2, DstMiscData%u2, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call BD_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call BD_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call BD_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call BD_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine BD_DestroyMisc(MiscData, ErrStat, ErrMsg) @@ -3238,6 +3293,16 @@ subroutine BD_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call BD_DestroyInput(MiscData%u2, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call BD_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call BD_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call BD_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call BD_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine BD_PackMisc(RF, Indata) @@ -3283,6 +3348,11 @@ subroutine BD_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%LP_indx) call BD_PackInput(RF, InData%u) call BD_PackInput(RF, InData%u2) + call NWTC_Library_PackModJacType(RF, InData%Jac) + call BD_PackContState(RF, InData%x_perturb) + call BD_PackContState(RF, InData%dxdt_lin) + call BD_PackInput(RF, InData%u_perturb) + call BD_PackOutput(RF, InData%y_lin) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -3332,6 +3402,11 @@ subroutine BD_UnPackMisc(RF, OutData) call RegUnpackAlloc(RF, OutData%LP_indx); if (RegCheckErr(RF, RoutineName)) return call BD_UnpackInput(RF, OutData%u) ! u call BD_UnpackInput(RF, OutData%u2) ! u2 + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call BD_UnpackContState(RF, OutData%x_perturb) ! x_perturb + call BD_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin + call BD_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call BD_UnpackOutput(RF, OutData%y_lin) ! y_lin end subroutine subroutine BD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) @@ -3675,5 +3750,347 @@ SUBROUTINE BD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function BD_InputMeshPointer(u, DL) result(Mesh) + type(BD_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (BD_u_RootMotion) + Mesh => u%RootMotion + case (BD_u_PointLoad) + Mesh => u%PointLoad + case (BD_u_DistrLoad) + Mesh => u%DistrLoad + case (BD_u_HubMotion) + Mesh => u%HubMotion + end select +end function + +function BD_OutputMeshPointer(y, DL) result(Mesh) + type(BD_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (BD_y_ReactionForce) + Mesh => y%ReactionForce + case (BD_y_BldMotion) + Mesh => y%BldMotion + end select +end function + +subroutine BD_VarsPackContState(Vars, x, ValAry) + type(BD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call BD_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine BD_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(BD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BD_x_q) + if (V%Field == FieldOrientation) then + VarVals = wm_to_quat(wm_inv(x%q(4:6, V%j))) ! Convert WM parameters to quaternions + else + VarVals = x%q(V%iLB:V%iUB,V%j) ! Rank 2 Array + end if + case (BD_x_dqdt) + VarVals = x%dqdt(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine BD_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(BD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call BD_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine BD_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(BD_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BD_x_q) + if (V%Field == FieldOrientation) then + x%q(4:6, V%j) = wm_inv(quat_to_wm(VarVals)) ! Convert quaternion to WM parameters + else + x%q(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end if + case (BD_x_dqdt) + x%dqdt(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + +function BD_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (BD_x_q) + Name = "x%q" + case (BD_x_dqdt) + Name = "x%dqdt" + case default + Name = "Unknown Field" + end select +end function + +subroutine BD_VarsPackContStateDeriv(Vars, x, ValAry) + type(BD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call BD_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine BD_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(BD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BD_x_q) + VarVals = x%q(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (BD_x_dqdt) + VarVals = x%dqdt(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine BD_VarsPackConstrState(Vars, z, ValAry) + type(BD_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call BD_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine BD_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(BD_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BD_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine BD_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(BD_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call BD_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine BD_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(BD_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BD_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function BD_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (BD_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine BD_VarsPackInput(Vars, u, ValAry) + type(BD_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call BD_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine BD_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(BD_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BD_u_RootMotion) + call MV_PackMesh(V, u%RootMotion, ValAry) ! Mesh + case (BD_u_PointLoad) + call MV_PackMesh(V, u%PointLoad, ValAry) ! Mesh + case (BD_u_DistrLoad) + call MV_PackMesh(V, u%DistrLoad, ValAry) ! Mesh + case (BD_u_HubMotion) + call MV_PackMesh(V, u%HubMotion, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine BD_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(BD_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call BD_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine BD_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(BD_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BD_u_RootMotion) + call MV_UnpackMesh(V, ValAry, u%RootMotion) ! Mesh + case (BD_u_PointLoad) + call MV_UnpackMesh(V, ValAry, u%PointLoad) ! Mesh + case (BD_u_DistrLoad) + call MV_UnpackMesh(V, ValAry, u%DistrLoad) ! Mesh + case (BD_u_HubMotion) + call MV_UnpackMesh(V, ValAry, u%HubMotion) ! Mesh + end select + end associate +end subroutine + +function BD_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (BD_u_RootMotion) + Name = "u%RootMotion" + case (BD_u_PointLoad) + Name = "u%PointLoad" + case (BD_u_DistrLoad) + Name = "u%DistrLoad" + case (BD_u_HubMotion) + Name = "u%HubMotion" + case default + Name = "Unknown Field" + end select +end function + +subroutine BD_VarsPackOutput(Vars, y, ValAry) + type(BD_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call BD_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine BD_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(BD_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BD_y_ReactionForce) + call MV_PackMesh(V, y%ReactionForce, ValAry) ! Mesh + case (BD_y_BldMotion) + call MV_PackMesh(V, y%BldMotion, ValAry) ! Mesh + case (BD_y_RootMxr) + VarVals(1) = y%RootMxr ! Scalar + case (BD_y_RootMyr) + VarVals(1) = y%RootMyr ! Scalar + case (BD_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine BD_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(BD_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call BD_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine BD_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(BD_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (BD_y_ReactionForce) + call MV_UnpackMesh(V, ValAry, y%ReactionForce) ! Mesh + case (BD_y_BldMotion) + call MV_UnpackMesh(V, ValAry, y%BldMotion) ! Mesh + case (BD_y_RootMxr) + y%RootMxr = VarVals(1) ! Scalar + case (BD_y_RootMyr) + y%RootMyr = VarVals(1) ! Scalar + case (BD_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function BD_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (BD_y_ReactionForce) + Name = "y%ReactionForce" + case (BD_y_BldMotion) + Name = "y%BldMotion" + case (BD_y_RootMxr) + Name = "y%RootMxr" + case (BD_y_RootMyr) + Name = "y%RootMyr" + case (BD_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE BeamDyn_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/beamdyn/src/Registry_BeamDyn.txt b/modules/beamdyn/src/Registry_BeamDyn.txt index 448cd81abe..33ab1808f6 100644 --- a/modules/beamdyn/src/Registry_BeamDyn.txt +++ b/modules/beamdyn/src/Registry_BeamDyn.txt @@ -42,6 +42,7 @@ typedef ^ InitInputType LOGICAL CompAeroMaps - .FALSE. - "fl 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" - +typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - #typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_z {:} - - "Names of the constraint states used in linearization" - typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_x {:} - - "Names of the continuous states used in linearization" - @@ -98,7 +99,6 @@ typedef ^ BD_InputFile ^ pitchC - - - "Pitch actuator dam #^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ typedef ^ BD_InputFile Logical Echo - - - "Echo" - typedef ^ BD_InputFile Logical RotStates - .TRUE. - "Orient states in rotating frame during linearization? (flag)" - -typedef ^ BD_InputFile Logical RelStates - .FALSE. - "Define states relative to root motion during linearization? (flag)" - typedef ^ BD_InputFile Logical tngt_stf_fd - - - "Flag to compute tangent stifness matrix via finite difference" - typedef ^ BD_InputFile Logical tngt_stf_comp - - - "Flag to compare finite differenced and analytical tangent stifness" - typedef ^ BD_InputFile IntKi NNodeOuts - - - "Number of node outputs [0 - 9]" - @@ -165,6 +165,7 @@ typedef ^ ^ ^ mEta ::: - - "Center of ma # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: +typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" typedef ^ ParameterType DbKi dt - - - "module dt" s typedef ^ ParameterType DbKi coef {9} - - "GA2 Coefficient" - typedef ^ ParameterType DbKi rhoinf - - - "Numerical Damping Coefficient for GA2" @@ -241,14 +242,7 @@ typedef ^ ParameterType ^ QPtw_ShpDer_ShpDer_Jac {:}{:}{:} typedef ^ ParameterType ^ QPtw_Shp_Jac {:}{:}{:} - - "optimization variable: QPtw_Shp_Jac(idx_qp,i,nelem) = p%Shp(i,idx_qp)*p%QPtWeight(idx_qp)*p%Jacobian(idx_qp,nelem)" - typedef ^ ParameterType ^ QPtw_ShpDer {:}{:} - - "optimization variable: QPtw_ShpDer(idx_qp,i) = p%ShpDer(i,idx_qp)*p%QPtWeight(idx_qp)" - typedef ^ ParameterType ^ FEweight {:}{:} - - "weighting factors for integrating local sectional loads" - - -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 {6} - - "vector that determines size of perturbation for x (continuous states)" -typedef ^ ParameterType Integer Jac_ny - - - "number of outputs in jacobian matrix" - -typedef ^ ParameterType Integer Jac_nx - - - "half the number of continuous states in jacobian matrix" - typedef ^ ParameterType logical RotStates - - - "Orient states in rotating frame during linearization? (flag)" - -typedef ^ ParameterType Logical RelStates - - - "Define states relative to root motion during linearization? (flag)" - typedef ^ ParameterType LOGICAL CompAeroMaps - .FALSE. - "flag to determine if BeamDyn is computing aero maps (true) or running a normal simulation (false)" - @@ -374,4 +368,8 @@ typedef ^ MiscVarType ^ LP_RHS_LU {:} - - "R typedef ^ MiscVarType IntKi LP_indx {:} - - "Index vector for LU" - typedef ^ MiscVarType BD_InputType u - - - "Inputs converted to the internal BD coordinate system" - typedef ^ MiscVarType BD_InputType u2 - - - "Inputs in the FAST coordinate system, possibly modified by pitch actuator" - - +typedef ^ MiscVarType ModJacType Jac - - - "Jacobian matrices and arrays corresponding to module variables" +typedef ^ MiscVarType BD_ContinuousStateType x_perturb - - - "" - +typedef ^ MiscVarType BD_ContinuousStateType dxdt_lin - - - "" - +typedef ^ MiscVarType BD_InputType u_perturb - - - "" - +typedef ^ MiscVarType BD_OutputType y_lin - - - "" - diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 4bce771cd6..75ffc6e4aa 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -62,9 +62,13 @@ MODULE ElastoDyn ! (Xd), and constraint-state (Z) equations all with respect to the constraint ! states (z) - PUBLIC :: ED_GetOP ! Routine to pack the operating point values (for linearization) into arrays + PUBLIC :: ED_PackExtInputAry ! Routine to pack extended inputs for linearization + + + PUBLIC :: ED_UpdateAzimuth CONTAINS + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the start of the simulation to perform initialization steps. !! The parameters are set here and not changed during the simulation. @@ -334,17 +338,6 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut IF (ErrStat >= AbortErrLev) RETURN InitOut%BlPitch = InputFileData%BlPitch(1:p%NumBl) - !............................................................................................ - ! set up data needed for linearization analysis - !............................................................................................ - - if (InitInp%Linearize .or. p%CompAeroMaps) then - call ED_Init_Jacobian(p, u, y, InitOut, ErrStat2, ErrMsg2) - call CheckError( ErrStat2, ErrMsg2 ) - if (ErrStat >= AbortErrLev) return - 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: @@ -352,6 +345,16 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut Interval = p%DT + !............................................................................................ + ! Module Variables + !............................................................................................ + + CALL ED_InitVars(u, p, x, y, m, InitOut%Vars, InputFileData, .true., ErrStat2, ErrMsg2) + CALL CheckError( ErrStat2, ErrMsg2 ) + + !............................................................................................ + ! Summary and cleanup + !............................................................................................ ! Print the summary file if requested: IF (InputFileData%SumPrint) THEN @@ -527,6 +530,20 @@ SUBROUTINE ED_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat IF ( ( x%QT(DOF_GeAz) + x%QT(DOF_DrTr) ) >= TwoPi_D ) x%QT(DOF_GeAz) = x%QT(DOF_GeAz) - TwoPi_D END SUBROUTINE ED_UpdateStates + +!> Limit azimuth to be between 0 and 2pi +SUBROUTINE ED_UpdateAzimuth(p, x, DT) + TYPE(ED_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(ED_ContinuousStateType), INTENT(INOUT) :: x + real(DbKi), INTENT(IN ) :: DT + + ! If the generator degree of freedom is not active, update the azimuth angle + IF (.not. p%DOF_Flag(DOF_GeAz)) x%QT(DOF_GeAz) = x%QT(DOF_GeAz) + DT*x%QDT(DOF_GeAz) + + ! If the azimuth is greater than 2pi, subtract 2pi + IF ((x%QT(DOF_GeAz) + x%QT(DOF_DrTr)) >= TwoPi_D) x%QT(DOF_GeAz) = x%QT(DOF_GeAz) - TwoPi_D +END SUBROUTINE + !---------------------------------------------------------------------------------------------------------------------------------- !> 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. @@ -1975,7 +1992,9 @@ SUBROUTINE ED_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta ENDDO ! I - All active (enabled) DOFs m%QD2T = dxdt%QDT - + + ! If computing AeroMaps, put accelerations where velocities would be located + if (p%CompAeroMaps) dxdt%QT = dxdt%QDT ! Let's calculate the sign (+/-1) of the low-speed shaft torque for this time step and store it in SgnPrvLSTQ. ! This will be used during the next call to RtHS (bjj: currently violates framework, but DOE wants a hack for HSS brake). @@ -10348,9 +10367,10 @@ END SUBROUTINE FixYawFric !---------------------------------------------------------------------------------------------------------------------------------- !> 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 ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu ) +SUBROUTINE ED_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) !.................................................................................................................................. + type(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(ED_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(ED_ParameterType), INTENT(IN ) :: p !< Parameters @@ -10365,214 +10385,164 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(ED_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] - + 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(ED_OutputType) :: y_p - TYPE(ED_OutputType) :: y_m - TYPE(ED_ContinuousStateType) :: x_p - TYPE(ED_ContinuousStateType) :: x_m - TYPE(ED_InputType) :: u_perturb - REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, j - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_JacobianPInput' + CHARACTER(*), PARAMETER :: RoutineName = 'ED_JacobianPInput' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, iCol + integer(IntKi) :: iVarBlPitchCom, iVarBlPitchComC - - ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' - m%IgnoreMod = .true. ! to compute perturbations, we need to ignore the modulo function - - ! make a copy of the inputs to perturb - call ED_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - - IF ( PRESENT( dYdu ) ) THEN + ! To compute perturbations, we need to ignore the modulo function + m%IgnoreMod = .true. + + ! Initialize pitch command variable indices + iVarBlPitchCom = 0 + iVarBlPitchComC = 0 + do i = 1, size(Vars%u) + select case (Vars%u(i)%DL%Num) + case (ED_u_BlPitchCom) + iVarBlPitchCom = i + case (ED_u_BlPitchComC) + iVarBlPitchComC = i + end select + end do + + ! Update copy of the inputs to perturb + call ED_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ED_VarsPackInput(Vars, u, m%Jac%u) - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + if (present(dYdu)) then - ! allocate dYdu if necessary + ! Allocate dYdu if not allocated if (.not. allocated(dYdu)) then - call AllocAry(dYdu, p%Jac_ny, size(p%Jac_u_indx,1)+p%NumExtendedInputs, 'dYdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dYdu, m%Jac%Ny, m%Jac%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if - - if (p%CompAeroMaps) then - dYdu = 0.0_R8Ki - else - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call ED_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call ED_CopyOutput( y, y_m, 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 u - call ED_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 - call ED_Perturb_u( p, i, 1, u_perturb, delta ) - - ! compute y at u_op + delta u - call ED_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, 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 u - call ED_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 - call ED_Perturb_u( p, i, -1, u_perturb, delta ) - - ! compute y at u_op - delta u - call ED_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, 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, dYdu(:,i) ) - + + ! Loop through input variables + do i = 1, size(Vars%u) + + ! Skip extended variable + if (i == iVarBlPitchComC) cycle + + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%u(i)%Num + + ! Calculate column index + iCol = Vars%u(i)%iLoc(1) + j - 1 + + ! Calculate positive perturbation + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call ED_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call ED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call ED_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call ED_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call ED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call ED_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) + + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(Vars%y, Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,iCol)) end do - - ! now do the extended input: sum the p%NumBl blade pitch columns - if (p%NumExtendedInputs > 0) then - dYdu(:,size(p%Jac_u_indx,1)+1) = dYdu(:,size(p%Jac_u_indx,1)-p%NumBl-1) ! last NumBl+2 columns are: GenTrq, YawMom, and BlPitchCom - do i=2,p%NumBl - dYdu(:,size(p%Jac_u_indx,1)+1) = dYdu(:,size(p%Jac_u_indx,1)+1) + dYdu(:,size(p%Jac_u_indx,1)-p%NumBl-2+i) - end do - end if - - - if (ErrStat>=AbortErrLev) then - call cleanup() - return + end do + + ! Extended: BlPitchComC is the sum of BlPitchCom across all blades + if (iVarBlPitchComC > 0) then + if (iVarBlPitchCom > 0) then + associate (Var => Vars%u(iVarBlPitchCom)) + dYdu(:,Vars%u(iVarBlPitchComC)%iLoc(1)) = sum(dYdu(:,Var%iLoc(1):Var%iLoc(2)), dim=2) + end associate + else + dYdu(:,Vars%u(iVarBlPitchComC)%iLoc(1)) = 0.0_R8Ki end if - call ED_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call ED_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - end if !CompAeroMaps + end if + end if + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + if (present(dXdu) .and. (m%Jac%Nx > 0)) then - END IF + ! Allocate dXdu if not allocated + if (.not. allocated(dXdu)) then + call AllocAry(dXdu, m%Jac%Nx, m%Jac%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return + end if + ! Loop through input variables + do i = 1, size(Vars%u) - IF ( PRESENT( dXdu ) ) THEN + ! Skip extended variable + if (i == iVarBlPitchComC) cycle - ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%u(i)%Num - ! allocate dXdu if necessary - if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%NActvDOF_Lin + p%NActvVelDOF_Lin, size(p%Jac_u_indx,1)+p%NumExtendedInputs, 'dXdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - end if - - - do i=1,size(p%Jac_u_indx,1) - - ! get u_op + delta u - call ED_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 - call ED_Perturb_u( p, i, 1, u_perturb, delta ) - - ! compute x at u_op + delta u - call ED_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get u_op - delta u - call ED_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - call ED_Perturb_u( p, i, -1, u_perturb, delta ) - - ! compute x at u_op - delta u - call ED_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! we may have had an error allocating memory, so we'll check - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - ! get central difference: - call Compute_dX( p, x_p, x_m, delta, dXdu(:,i) ) + ! Calculate column index + iCol = Vars%u(i)%iLoc(1) + j - 1 - end do - - - ! now do the extended input: sum the p%NumBl blade pitch columns - if (p%NumExtendedInputs > 0) then - dXdu(:,size(p%Jac_u_indx,1)+1) = dXdu(:,size(p%Jac_u_indx,1)-p%NumBl-1) ! last NumBl+2 columns are: GenTrq, YawMom, and BlPitchCom - do i=2,p%NumBl - dXdu(:,size(p%Jac_u_indx,1)+1) = dXdu(:,size(p%Jac_u_indx,1)+1) + dXdu(:,size(p%Jac_u_indx,1)-p%NumBl-2+i) + ! Calculate positive perturbation + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call ED_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call ED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call ED_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call ED_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call ED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call ED_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_neg) + + ! Get partial derivative via central difference and store in full linearization array + dXdu(:,iCol) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%u(i)%Perturb) end do + end do + + ! Extended: BlPitchComC is the sum of BlPitchCom across all blades + if (iVarBlPitchComC > 0) then + if (iVarBlPitchCom > 0) then + associate (Var => Vars%u(iVarBlPitchCom)) + dXdu(:,Vars%u(iVarBlPitchComC)%iLoc(1)) = sum(dXdu(:,Var%iLoc(1):Var%iLoc(2)), dim=2) + end associate + else + dXdu(:,Vars%u(iVarBlPitchComC)%iLoc(1)) = 0.0_R8Ki + end if end if - - call ED_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call ED_DestroyContState( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - - - END IF + end if - - IF ( PRESENT( dXddu ) ) THEN + if (present(dXddu)) then if (allocated(dXddu)) deallocate(dXddu) - END IF + end if - IF ( PRESENT( dZdu ) ) THEN + if (present(dZdu)) then if (allocated(dZdu)) deallocate(dZdu) - END IF + end if call cleanup() contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call cleanup() + end function subroutine cleanup() - call ED_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call ED_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call ED_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call ED_DestroyContState( x_m, ErrStat2, ErrMsg2 ) - call ED_DestroyInput( u_perturb, ErrStat2, ErrMsg2 ) m%IgnoreMod = .false. end subroutine cleanup - END SUBROUTINE ED_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) -!.................................................................................................................................. +SUBROUTINE ED_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) + type(ModVarsType), INTENT(IN ) :: Vars !< Module variables 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) TYPE(ED_ParameterType), INTENT(IN ) :: p !< Parameters @@ -10587,177 +10557,115 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, TYPE(ED_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions (Y) with respect - !! to the continuous states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) with respect - !! to the continuous states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) with respect - !! to the continuous states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) with respect - !! to the continuous states (x) [intent in to avoid deallocation] - - ! local variables - TYPE(ED_OutputType) :: y_p - TYPE(ED_OutputType) :: y_m - TYPE(ED_ContinuousStateType) :: x_p - TYPE(ED_ContinuousStateType) :: x_m - TYPE(ED_ContinuousStateType) :: x_perturb - REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, j - + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions (Y) with respect to the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) with respect to the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) with respect to the continuous states (x) [intent in to avoid deallocation] + + CHARACTER(*), PARAMETER :: RoutineName = 'ED_JacobianPContState' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_JacobianPContState' + INTEGER(IntKi) :: i, j, iCol - - ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' + m%IgnoreMod = .true. ! to get true perturbations, we can't use the modulo function - ! make a copy of the continuous states to perturb - call ED_CopyContState( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + ! Copy state values + call ED_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ED_VarsPackContState(Vars, x, m%Jac%x) - IF ( PRESENT( dYdx ) ) THEN + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + if (present(dYdx)) then - ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: - - ! allocate dYdx if necessary + ! Allocate dYdx if not allocated if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Jac_ny, p%NActvDOF_Lin + p%NActvVelDOF_Lin, 'dYdx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dYdx, m%Jac%Ny, m%Jac%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return end if - - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call ED_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call ED_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - - do i=1,p%NActvDOF_Lin + p%NActvVelDOF_Lin - - ! get x_op + delta x - call ED_CopyContState( x, x_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 - call ED_Perturb_x( p, i, 1, x_perturb, delta ) - - ! compute y at x_op + delta x - call ED_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, 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 x_op - delta x - call ED_CopyContState( x, x_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 - call ED_Perturb_x( p, i, -1, x_perturb, delta ) - - ! compute y at x_op - delta x - call ED_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, 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, dYdx(:,i) ) - - end do - - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - call ED_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call ED_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - END IF - IF ( PRESENT( dXdx ) ) THEN + ! Loop through state variables + do i = 1, size(Vars%x) - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%x(i)%Num - ! allocate dXdx if necessary + ! Calculate column index + iCol = Vars%x(i)%iLoc(1) + j - 1 + + ! Calculate positive perturbation + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call ED_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call ED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call ED_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call ED_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call ED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call ED_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) + + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(Vars%y, Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,iCol)) + end do + end do + + end if + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + if (present(dXdx) .and. (m%Jac%Nx > 0)) then + + ! Allocate dXdx if not allocated if (.not. allocated(dXdx)) then - call AllocAry(dXdx, p%NActvDOF_Lin + p%NActvVelDOF_Lin, p%NActvDOF_Lin + p%NActvVelDOF_Lin, 'dXdx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dXdx, m%Jac%Nx, m%Jac%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return end if - - do i=1,p%NActvDOF_Lin + p%NActvVelDOF_Lin - - ! get x_op + delta x - call ED_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call ED_Perturb_x( p, i, 1, x_perturb, delta ) - - ! compute x at x_op + delta x - call ED_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get x_op - delta x - call ED_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call ED_Perturb_x( p, i, -1, x_perturb, delta ) - - ! compute x at x_op - delta x - call ED_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! we may have had an error allocating memory, so we'll check - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - ! get central difference: - - call Compute_dX( p, x_p, x_m, delta, dXdx(:,i) ) - + ! Loop through state variables + do i = 1, size(Vars%x) + + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%x(i)%Num + + ! Calculate column index + iCol = Vars%x(i)%iLoc(1) + j - 1 + + ! Calculate positive perturbation + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call ED_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call ED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call ED_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call ED_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call ED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call ED_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_neg) + + ! Get partial derivative via central difference and store in full linearization array + dXdx(:,iCol) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%x(i)%Perturb) + end do end do - - call ED_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call ED_DestroyContState( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - END IF + end if - IF ( PRESENT( dXddx ) ) THEN + if (present(dXddx)) then if (allocated(dXddx)) deallocate(dXddx) - END IF + end if - IF ( PRESENT( dZdx ) ) THEN + if (present(dZdx)) then if (allocated(dZdx)) deallocate(dZdx) - END IF + end if call cleanup() contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call cleanup() + end function subroutine cleanup() - call ED_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call ED_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call ED_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call ED_DestroyContState( x_m, ErrStat2, ErrMsg2 ) - call ED_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) m%IgnoreMod = .false. end subroutine cleanup - END SUBROUTINE ED_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions @@ -10792,45 +10700,25 @@ SUBROUTINE ED_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, !! functions (Z) with respect to the !! discrete states (xd) [intent in to avoid deallocation] - - ! Initialize ErrStat - + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' + ! Calculate the partial derivative of the output functions (Y) with respect to the discrete states (xd) here: + if (present(dYdxd)) then + end if - IF ( PRESENT( dYdxd ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the discrete states (xd) here: - - ! allocate and set dYdxd - - END IF - - IF ( PRESENT( dXdxd ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the discrete states (xd) here: - - ! allocate and set dXdxd - - END IF - - IF ( PRESENT( dXddxd ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the discrete states (xd) here: - - ! allocate and set dXddxd - - END IF - - IF ( PRESENT( dZdxd ) ) THEN - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the discrete states (xd) here: - - ! allocate and set dZdxd - - END IF + ! Calculate the partial derivative of the continuous state functions (X) with respect to the discrete states (xd) here: + if (present(dXdxd)) then + end if + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the discrete states (xd) here: + if (present(dXddxd)) then + end if + + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the discrete states (xd) here: + if (present(dZdxd)) then + end if END SUBROUTINE ED_JacobianPDiscState !---------------------------------------------------------------------------------------------------------------------------------- @@ -10862,1035 +10750,479 @@ SUBROUTINE ED_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdz(:,:) !< Partial derivatives of constraint state functions (Z) with respect !! to the constraint states (z) [intent in to avoid deallocation] - - ! Initialize ErrStat - + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' - IF ( PRESENT( dYdz ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z) here: - - ! allocate and set dYdz - - END IF - - IF ( PRESENT( dXdz ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the constraint states (z) here: - - ! allocate and set dXdz - - END IF - - IF ( PRESENT( dXddz ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the constraint states (z) here: - - ! allocate and set dXddz - - END IF - - IF ( PRESENT( dZdz ) ) THEN - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z) here: + ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z) here: + if (present(dYdz)) then + end if - ! allocate and set dZdz + ! Calculate the partial derivative of the continuous state functions (X) with respect to the constraint states (z) here: + if (present(dXdz)) then + end if - END IF + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the constraint states (z) here: + if (present(dXddz)) then + end if + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z) here: + if (present(dZdz)) then + end if END SUBROUTINE ED_JacobianPConstrState !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the Jacobian parameters and initialization outputs for the linearized outputs. -SUBROUTINE ED_Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) +subroutine ED_PackExtInputAry(Vars, u, ValAry, ErrStat, ErrMsg) + type(ModVarsType), intent(in) :: Vars + type(ED_InputType), intent(in) :: u !< Inputs + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi),intent(out) :: ErrStat !< Error status of the operation + character(*),intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'ED_PackExtInputAry' + integer(IntKi) :: i - TYPE(ED_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(ED_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(ED_InitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine - - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables: - INTEGER(IntKi) :: i,j,k, index_last, index_next - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_Init_Jacobian_y' - LOGICAL :: Mask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing - LOGICAL :: BladeMask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing - logical, allocatable :: AllOut(:) - - - ErrStat = ErrID_None - ErrMsg = "" - - - ! determine how many outputs there are in the Jacobians - p%Jac_ny = 0 - BladeMask = .true. ! default is all the fields - if (p%CompAeroMaps) then - if (allocated(y%BladeLn2Mesh)) then - do i=1,p%NumBl_Lin - p%Jac_ny = p%Jac_ny + y%BladeLn2Mesh(i)%NNodes * 12 ! 3 TranslationDisp, Orientation, TranslationVel, and RotationVel at each node on each blade (skip accelerations) - end do - end if - BladeMask(MASKID_TRANSLATIONACC) = .false. - BladeMask(MASKID_ROTATIONACC) = .false. - else - - if (allocated(y%BladeLn2Mesh)) then - do i=1,p%NumBl_Lin - p%Jac_ny = p%Jac_ny + y%BladeLn2Mesh(i)%NNodes * 18 ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node on each blade - end do - end if - - p%Jac_ny = p%Jac_ny & - + y%PlatformPtMesh%NNodes * 18 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, RotationAcc at each node - + y%TowerLn2Mesh%NNodes * 18 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, RotationAcc at each node - + y%HubPtMotion%NNodes * 9 & ! 3 TranslationDisp, Orientation, RotationVel at each node - + y%NacelleMotion%NNodes * 18 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, RotationAcc at each node - + y%TFinCMMotion%NNodes * 12 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel at each node - + 3 & ! Yaw, YawRate, and HSS_Spd - + p%NumOuts + p%BldNd_TotNumOuts ! WriteOutput values - - do i=1,p%NumBl_Lin - 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 - end do + ErrMsg = "" - end if - - !................. - ! set linearization output names: - !................. - CALL AllocAry(InitOut%LinNames_y, p%Jac_ny, 'LinNames_y', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%RotFrame_y, p%Jac_ny, 'RotFrame_y', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + ! Find variable index corresponding to blade pitch command collective + i = MV_FindVarDatLoc(Vars%u, DatLoc(ED_u_BlPitchComC)) - InitOut%RotFrame_y = .false. ! note that meshes are in the global, not rotating frame - - - index_next = 1 - if (allocated(y%BladeLn2Mesh)) then - index_last = index_next - p%Jac_y_idxStartList%Blade = index_next - do i=1,p%NumBl_Lin - call PackMotionMesh_Names(y%BladeLn2Mesh(i), 'Blade '//trim(num2lstr(i)), InitOut%LinNames_y, index_next, FieldMask=BladeMask) - end do - end if - - if (.not. p%CompAeroMaps) then - p%Jac_y_idxStartList%Platform = index_next - call PackMotionMesh_Names(y%PlatformPtMesh, 'Platform', InitOut%LinNames_y, index_next) - p%Jac_y_idxStartList%Tower = index_next - call PackMotionMesh_Names(y%TowerLn2Mesh, 'Tower', InitOut%LinNames_y, index_next) - - ! note that this Mask is for the y%HubPtMotion mesh ONLY. The others pack *all* of the motion fields - Mask = .false. - Mask(MASKID_TRANSLATIONDISP) = .true. - Mask(MASKID_ORIENTATION) = .true. - Mask(MASKID_ROTATIONVEL) = .true. - - p%Jac_y_idxStartList%Hub = index_next - call PackMotionMesh_Names(y%HubPtMotion, 'Hub', InitOut%LinNames_y, index_next, FieldMask=Mask) - index_last = index_next - p%Jac_y_idxStartList%BladeRoot = index_next - do i=1,p%NumBl_Lin - call PackMotionMesh_Names(y%BladeRootMotion(i), 'Blade root '//trim(num2lstr(i)), InitOut%LinNames_y, index_next) - end do - - p%Jac_y_idxStartList%Nacelle = index_next - call PackMotionMesh_Names(y%NacelleMotion, 'Nacelle', InitOut%LinNames_y, index_next) - - Mask = .false. - Mask(MASKID_TRANSLATIONDISP) = .true. - Mask(MASKID_ORIENTATION) = .true. - Mask(MASKID_TRANSLATIONVEL) = .true. - Mask(MASKID_ROTATIONVEL) = .true. - p%Jac_y_idxStartList%TFin = index_next - call PackMotionMesh_Names(y%TFinCMMotion, 'TailFin', InitOut%LinNames_y, index_next, FieldMask=Mask) - - InitOut%LinNames_y(index_next) = 'Yaw, rad'; index_next = index_next+1 - 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 + 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 - - - !! check for AllOuts in rotating frame - allocate( AllOut(0:MaxOutPts), STAT=ErrStat2 ) ! allocate starting at zero to account for invalid output channels - if (ErrStat2 /=0 ) then - call SetErrStat(ErrID_Info, 'error allocating temporary space for AllOut',ErrStat,ErrMsg,RoutineName) - return; - end if - - AllOut = .false. - do k=1,3 - AllOut(TipDxc( k)) = .true. - AllOut(TipDyc( k)) = .true. - AllOut(TipDzc( k)) = .true. - AllOut(TipDxb( k)) = .true. - AllOut(TipDyb( k)) = .true. - AllOut(TipALxb( k)) = .true. - AllOut(TipALyb( k)) = .true. - AllOut(TipALzb( k)) = .true. - AllOut(TipRDxb( k)) = .true. - AllOut(TipRDyb( k)) = .true. - AllOut(TipRDzc( k)) = .true. - AllOut(TipClrnc(k)) = .true. - AllOut(PtchPMzc(k)) = .true. - AllOut(RootFxc( k)) = .true. - AllOut(RootFyc( k)) = .true. - AllOut(RootFzc( k)) = .true. - AllOut(RootFxb( k)) = .true. - AllOut(RootFyb( k)) = .true. - AllOut(RootMxc( k)) = .true. - AllOut(RootMyc( k)) = .true. - AllOut(RootMzc( k)) = .true. - AllOut(RootMxb( k)) = .true. - AllOut(RootMyb( k)) = .true. - - do j=1,9 - AllOut(SpnALxb( j,k)) = .true. - AllOut(SpnALyb( j,k)) = .true. - AllOut(SpnALzb( j,k)) = .true. - AllOut(SpnFLxb( j,k)) = .true. - AllOut(SpnFLyb( j,k)) = .true. - AllOut(SpnFLzb( j,k)) = .true. - AllOut(SpnMLxb( j,k)) = .true. - AllOut(SpnMLyb( j,k)) = .true. - AllOut(SpnMLzb( j,k)) = .true. - AllOut(SpnTDxb( j,k)) = .true. - AllOut(SpnTDyb( j,k)) = .true. - AllOut(SpnTDzb( j,k)) = .true. - AllOut(SpnRDxb( j,k)) = .true. - AllOut(SpnRDyb( j,k)) = .true. - AllOut(SpnRDzb( j,k)) = .true. - end do - end do - - do i=1,p%NumOuts - 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. + ! If variable found + if (i > 0) then + + ! Copy to value array + ValAry(Vars%u(i)%iLoc(1):Vars%u(i)%iLoc(2)) = u%BlPitchCom(1) + + ! Check that all blades have the same pitch command + do i = 2, size(u%BlPitchCom) + if (.not. EqualRealNos(u%BlPitchCom(1), u%BlPitchCom(i))) then + call SetErrStat(ErrID_Info,"Operating point of collective pitch extended input is invalid because "// & + "the commanded blade pitch angles are not the same for each blade.", & + ErrStat, ErrMsg, RoutineName) + exit + end if end do - - deallocate(AllOut) - end if !.not. p%CompAeroMaps - -END SUBROUTINE ED_Init_Jacobian_y -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the Jacobian parameters and initialization outputs for the linearized continuous states. -SUBROUTINE ED_Init_Jacobian_x( p, InitOut, ErrStat, ErrMsg) + end if +end subroutine + +subroutine ED_InitVars(u, p, x, y, m, Vars, InputFileData, Linearize, ErrStat, ErrMsg) + type(ED_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(ED_ParameterType), intent(inout) :: p !< Parameters + type(ED_ContinuousStateType), intent(inout) :: x !< Continuous state + type(ED_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(ED_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(ModVarsType), intent(inout) :: Vars !< Module variables + type(ED_InputFile), intent(in) :: InputFileData !< Input file data + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'ED_InitVars' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + integer(IntKi) :: i, j, k + integer(IntKi), allocatable :: BladeMeshFields(:) + real(R8Ki) :: MaxThrust, MaxTorque, ScaleLength + integer(IntKi) :: Flags, Field - TYPE(ED_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(ED_InitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine - - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_Init_Jacobian_x' - - ! local variables: - INTEGER(IntKi) :: i, indx - ErrStat = ErrID_None - ErrMsg = "" - - if (p%CompAeroMaps) then - p%NActvDOF_Lin = p%DOFs%NActvDOF / p%NumBl ! we have only blade DOFs, and we are going to use only 1 of the blades - p%NActvDOF_Stride = p%NumBl - p%NActvVelDOF_Lin = 0 ! we do NOT have velocity states - else - p%NActvDOF_Lin = p%DOFs%NActvDOF - p%NActvDOF_Stride = 1 - p%NActvVelDOF_Lin = p%NActvDOF_Lin ! we have velocity states - end if - - ! allocate space for the row/column names and for perturbation sizes - call allocAry(p%dx, p%NDof, 'p%dx', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%LinNames_x, p%NActvDOF_Lin + p%NActvVelDOF_Lin,'LinNames_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%RotFrame_x, p%NActvDOF_Lin + p%NActvVelDOF_Lin,'RotFrame_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%DerivOrder_x, p%NActvDOF_Lin + p%NActvVelDOF_Lin,'DerivOrder_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - ! All Elastodyn continuous states are max order = 2 - if ( allocated(InitOut%DerivOrder_x) ) InitOut%DerivOrder_x = 2 - - p%dx = 0.0_R8Ki ! initialize in case we have only 1 blade - - ! set perturbation sizes: p%dx - p%dx(DOF_Sg :DOF_Hv) = 0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi) ! platform translational displacement states - p%dx(DOF_R :DOF_Y ) = 2.0_R8Ki * D2R_D ! platform rotational states - p%dx(DOF_TFA1:DOF_TSS1) = 0.020_R8Ki * D2R_D * p%TwrFlexL ! tower deflection states: 1st tower - p%dx(DOF_TFA2:DOF_TSS2) = 0.002_R8Ki * D2R_D * p%TwrFlexL ! tower deflection states: 2nd tower - p%dx(DOF_Yaw :DOF_TFrl) = 2.0_R8Ki * D2R_D ! nacelle-yaw, rotor-furl, generator azimuth, drivetrain, and tail-furl rotational states - - do i=1,p%NumBl - p%dx(DOF_BF(i,1))= 0.20_R8Ki * D2R_D * p%BldFlexL ! blade-deflection states: 1st blade flap mode - p%dx(DOF_BF(i,2))= 0.02_R8Ki * D2R_D * p%BldFlexL ! blade-deflection states: 2nd blade flap mode for blades (1/10 of the other perturbations) - p%dx(DOF_BE(i,1))= 0.20_R8Ki * D2R_D * p%BldFlexL ! blade-deflection states: 1st blade edge mode - end do - - if ( p%NumBl == 2 ) then - p%dx(DOF_Teet) = 2.0_R8Ki * D2R_D ! rotor-teeter rotational state - end if - - !Set some limits in case perturbation is very small - do i=1,p%NDof - p%dx(i) = max(p%dx(i), MinPerturb) + ErrMsg = "" + + ! Clear module variables type + call NWTC_Library_DestroyModVarsType(Vars, ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + ! Add continuous state variables (translation and rotation) + call MV_AddVar(Vars%x, 'PlatformSurge', FieldTransDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_Sg, & + Flags=VF_DerivOrder2, & + Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & + LinNames=['Platform horizontal surge translation DOF (internal DOF index = DOF_Sg), m'], & + Active=InputFileData%PtfmSgDOF) + + call MV_AddVar(Vars%x, 'PlatformSway', FieldTransDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_Sw, & + Flags=VF_DerivOrder2, & + Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & + LinNames=['Platform horizontal sway translation DOF (internal DOF index = DOF_Sw), m'], & + Active=InputFileData%PtfmSwDOF) + + call MV_AddVar(Vars%x, 'PlatformHeave', FieldTransDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_Hv, & + Flags=VF_DerivOrder2, & + Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & + LinNames=['Platform vertical heave translation DOF (internal DOF index = DOF_Hv), m'], & + Active=InputFileData%PtfmHvDOF) + + call MV_AddVar(Vars%x, 'PlatformRoll', FieldAngularDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_R, & + Flags=VF_DerivOrder2, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Platform roll tilt rotation DOF (internal DOF index = DOF_R), rad'], & + Active=InputFileData%PtfmRDOF) + + call MV_AddVar(Vars%x, 'PlatformPitch', FieldAngularDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_P, & + Flags=VF_DerivOrder2, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Platform pitch tilt rotation DOF (internal DOF index = DOF_P), rad'], & + Active=InputFileData%PtfmPDOF) + + call MV_AddVar(Vars%x, 'PlatformYaw', FieldAngularDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_Y, & + Flags=VF_DerivOrder2, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Platform yaw rotation DOF (internal DOF index = DOF_Y), rad'], & + Active=InputFileData%PtfmYDOF) + + call MV_AddVar(Vars%x, 'TowerFA1', FieldTransDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_TFA1, & + Flags=VF_DerivOrder2, & + Perturb=0.020_R8Ki * D2R_D * p%TwrFlexL, & + LinNames=['1st tower fore-aft bending mode DOF (internal DOF index = DOF_TFA1), m'], & + Active=InputFileData%TwFADOF1) + + call MV_AddVar(Vars%x, 'TowerSS1', FieldTransDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_TSS1, & + Flags=VF_DerivOrder2, & + Perturb=0.020_R8Ki * D2R_D * p%TwrFlexL, & + LinNames=['1st tower side-to-side bending mode DOF (internal DOF index = DOF_TSS1), m'], & + Active=InputFileData%TwSSDOF1) + + call MV_AddVar(Vars%x, 'TowerFA2', FieldTransDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_TFA2, & + Flags=VF_DerivOrder2, & + Perturb=0.002_R8Ki * D2R_D * p%TwrFlexL, & + LinNames=['2nd tower fore-aft bending mode DOF (internal DOF index = DOF_TFA2), m'], & + Active=InputFileData%TwFADOF2) + + call MV_AddVar(Vars%x, 'TowerSS2', FieldTransDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_TSS2, & + Flags=VF_DerivOrder2, & + Perturb=0.002_R8Ki * D2R_D * p%TwrFlexL, & + LinNames=['2nd tower side-to-side bending mode DOF (internal DOF index = DOF_TSS2), m'], & + Active=InputFileData%TwSSDOF2) + + call MV_AddVar(Vars%x, 'NacelleYaw', FieldAngularDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_Yaw, & + Flags=VF_DerivOrder2, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Nacelle yaw DOF (internal DOF index = DOF_Yaw), rad'], & + Active=InputFileData%YawDOF) + + call MV_AddVar(Vars%x, 'RotorFurl', FieldAngularDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_RFrl, & + Flags=VF_DerivOrder2 + VF_AeroMap, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Rotor-furl DOF (internal DOF index = DOF_RFrl), rad'], & + Active=InputFileData%RFrlDOF) + + call MV_AddVar(Vars%x, 'GeneratorAzimuth', FieldAngularDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_GeAz, & + Flags=VF_DerivOrder2, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Variable speed generator DOF (internal DOF index = DOF_GeAz), rad'], & + Active=InputFileData%GenDOF) + + call MV_AddVar(Vars%x, 'DrivetrainFlexibility', FieldAngularDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_DrTr, & + Flags=VF_DerivOrder2, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Drivetrain rotational-flexibility DOF (internal DOF index = DOF_DrTr), rad'], & + Active=InputFileData%DrTrDOF) + + call MV_AddVar(Vars%x, 'TailFurl', FieldAngularDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_TFrl, & + Flags=VF_DerivOrder2 + VF_AeroMap, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Tail-furl DOF (internal DOF index = DOF_TFrl), rad'], & + Active=InputFileData%TFrlDOF) + + call MV_AddVar(Vars%x, 'RotorTeeter', FieldAngularDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_Teet, & + Flags=VF_DerivOrder2, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Hub teetering DOF (internal DOF index = DOF_Teet), rad'], & + Active=InputFileData%TeetDOF) + + do i = 1, p%NumBl + Flags = ior(VF_RotFrame, VF_DerivOrder2) + if (i == 1) Flags = ior(Flags, VF_AeroMap) + call MV_AddVar(Vars%x, 'Blade'//trim(Num2LStr(i))//'Flap1', FieldTransDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_BF(i,1), & + Flags=Flags, & + Perturb=0.20_R8Ki * D2R_D * p%BldFlexL, & + LinNames=['1st flapwise bending-mode DOF of blade '//trim(Num2LStr(i))//& + ' (internal DOF index = DOF_BF('//trim(Num2LStr(i))//',1)), m'], & + Active=InputFileData%FlapDOF1) end do - - if (p%CompAeroMaps) then - InitOut%RotFrame_x = .true. - else - InitOut%RotFrame_x = .false. - do i=1,p%DOFs%NActvDOF - if ( p%DOFs%PS(i) >= DOF_BF(1,1) ) then - if ( p%NumBl == 2 ) then - InitOut%RotFrame_x(i) = p%DOFs%PS(i) < DOF_Teet - else - InitOut%RotFrame_x(i) = .true. ! = p%DOFs%PS(i) <= DOF_BF (MaxBl,NumBF) - end if - end if - end do - end if - - ! set linearization output names: - indx = 0 - do i=1,p%DOFs%NActvDOF,p%NActvDOF_Stride - indx = indx + 1 - InitOut%LinNames_x(indx) = p%DOF_Desc( p%DOFs%PS(i) ) + + do i = 1, p%NumBl + Flags = ior(VF_RotFrame, VF_DerivOrder2) + if (i == 1) Flags = ior(Flags, VF_AeroMap) + call MV_AddVar(Vars%x, 'Blade'//trim(Num2LStr(i))//'Edge1', FieldTransDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_BE(i,1), & + Flags=Flags, & + Perturb=0.20_R8Ki * D2R_D * p%BldFlexL, & + LinNames=['1st edgewise bending-mode DOF of blade '//trim(Num2LStr(i))//& + ' (internal DOF index = DOF_BE('//trim(Num2LStr(i))//',1)), m'], & + Active=InputFileData%EdgeDOF) end do - - do i=1,p%NActvVelDOF_Lin - InitOut%LinNames_x(i+p%NActvDOF_Lin) = 'First time derivative of '//trim(InitOut%LinNames_x(i))//'/s' - InitOut%RotFrame_x(i+p%NActvDOF_Lin) = InitOut%RotFrame_x(i) + do i = 1, p%NumBl + Flags = ior(VF_RotFrame, VF_DerivOrder2) + if (i == 1) Flags = ior(Flags, VF_AeroMap) + call MV_AddVar(Vars%x, 'Blade'//trim(Num2LStr(i))//'Flap2', FieldTransDisp, & + DL=DatLoc(ED_x_QT), iAry=DOF_BF(i,2), & + Flags=Flags, & + Perturb=0.02_R8Ki * D2R_D * p%BldFlexL, & + LinNames=['2nd flapwise bending-mode DOF of blade '//trim(Num2LStr(i))//& + ' (internal DOF index = DOF_BF('//trim(Num2LStr(i))//',2)), m'], & + Active=InputFileData%FlapDOF2) end do - -END SUBROUTINE ED_Init_Jacobian_x -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the array that maps rows/columns of the Jacobian to specific mesh fields. -!! Do not change the order of this packing without changing corresponding linearization routines ! -SUBROUTINE ED_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) - TYPE(ED_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(ED_InputType) , INTENT(IN ) :: u !< inputs - TYPE(ED_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(ED_InitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_Init_Jacobian' - - ! local variables: - INTEGER(IntKi) :: i, j, k, index, index_last, nu, i_meshField, m - REAL(R8Ki) :: MaxThrust, MaxTorque - REAL(R8Ki) :: ScaleLength - - - ErrStat = ErrID_None - ErrMsg = "" - - if (p%CompAeroMaps) then - p%NumBl_Lin = 1 - else - p%NumBl_Lin = p%NumBl - end if - - - call ED_Init_Jacobian_y( p, y, InitOut, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call ED_Init_Jacobian_x( p, InitOut, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - - ! determine how many inputs there are in the Jacobians - nu = 0; - if (allocated(u%BladePtLoads)) then - do i=1,p%NumBl_Lin - nu = nu + u%BladePtLoads(i)%NNodes * 6 ! 3 forces + 3 moments at each node on each blade - end do - end if - - if (p%CompAeroMaps) then - p%NumExtendedInputs = 0 - else - nu = nu & - + u%PlatformPtMesh%NNodes * 6 & ! 3 forces + 3 moments at each node - + u%TowerPtLoads%NNodes * 6 & ! 3 forces + 3 moments at each node - + u%HubPtLoad%NNodes * 6 & ! 3 forces + 3 moments at each node - + u%NacelleLoads%NNodes * 6 & ! 3 forces + 3 moments at each node - + u%TFinCMLoads%NNodes * 6 & ! 3 forces + 3 moments at each node - + p%NumBl & ! blade pitch command (BlPitchCom) - + 2 ! YawMom and GenTrq - p%NumExtendedInputs = 1 - end if - ! note: all other inputs are ignored - - !.................... - ! fill matrix to store index to help us figure out what the ith value of the u vector really means - ! (see elastodyn::ed_perturb_u ... these MUST match ) - ! column 1 indicates module's mesh and field - ! column 2 indicates the first index of the acceleration/load field - ! column 3 is the node - !.................... - - !............... - ! ED input mappings stored in p%Jac_u_indx: - !............... - call AllocAry(p%Jac_u_indx, nu, 3, 'p%Jac_u_indx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - - index = 1 - if (allocated(u%BladePtLoads)) then - p%Jac_u_idxStartList%BladeLoad = index - !Module/Mesh/Field: u%BladePtLoads(1)%Force = 1; - !Module/Mesh/Field: u%BladePtLoads(1)%Moment = 2; - !Module/Mesh/Field: u%BladePtLoads(2)%Force = 3; - !Module/Mesh/Field: u%BladePtLoads(2)%Moment = 4; - !Module/Mesh/Field: u%BladePtLoads(3)%Force = 5; - !Module/Mesh/Field: u%BladePtLoads(3)%Moment = 6; - do k=1,p%NumBl_Lin - - do i_meshField = 1,2 - do i=1,u%BladePtLoads(k)%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField + (k-1)*2 !Module/Mesh/Field: u%BladePtLoads(k)%{Force/Moment} = m - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - - end do !i_meshField - end do !k - - end if + ! Derivatives of continuous state variables + if (allocated(Vars%x)) then + do i = 1, size(Vars%x) - if (.not. p%CompAeroMaps) then - p%Jac_u_idxStartList%PlatformLoad = index - do i_meshField = 7,8 - do i=1,u%PlatformPtMesh%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%PlatformPtMesh%Force = 7; u%PlatformPtMesh%Moment = 8; - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do + ! Increase variable perturbation if below minimum + Vars%x(i)%Perturb = max(Vars%x(i)%Perturb, MinPerturb) - p%Jac_u_idxStartList%TowerLoad = index - do i_meshField = 9,10 - do i=1,u%TowerPtLoads%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%TowerPtLoads%Force = 9; u%TowerPtLoads%Moment = 10; - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i + ! Update from position to velocity + select case (Vars%x(i)%Field) + case (FieldTransDisp) + Field = FieldTransVel + case (FieldAngularDisp) + Field = FieldAngularVel + end select + + ! Add variable (only active variables are in x) + call MV_AddVar(Vars%x, Vars%x(i)%Name, Field, & + DatLoc(ED_x_QDT), iAry=Vars%x(i)%iLB, & + Flags=Vars%x(i)%Flags, & + Perturb=Vars%x(i)%Perturb, & + LinNames=['First time derivative of '//trim(Vars%x(i)%LinNames(1))//'/s']) + + ! Remove aero map flag from velocity variable + call MV_ClearFlags(Vars%x(size(Vars%x)), VF_AeroMap) end do + end if - p%Jac_u_idxStartList%HubLoad = index - do i_meshField = 11,12 - do i=1,u%HubPtLoad%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%HubPtLoad%Force = 11; u%HubPtLoad%Moment = 12; - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - p%Jac_u_idxStartList%NacelleLoad = index - do i_meshField = 13,14 - do i=1,u%NacelleLoads%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%NacelleLoads%Force = 13; u%NacelleLoads%Moment = 14; - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- - p%Jac_u_idxStartList%TFinLoad = index - do i_meshField = 15,16 - do i=1,u%TFinCMLoads%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%TFinCMLoads%Force = 15; u%TFinCMLoads%Moment = 16; - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - p%Jac_u_idxStartList%BlPitchCom = index - do i_meshField = 1,p%NumBl ! scalars - p%Jac_u_indx(index,1) = 17 !Module/Mesh/Field: u%BlPitchCom = 17; - p%Jac_u_indx(index,2) = 1 !index: n/a - p%Jac_u_indx(index,3) = i_meshField !Node: blade - index = index + 1 - end do - - do i_meshField = 18,19 ! scalars - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%YawMom = 18; u%GenTrq = 19; - p%Jac_u_indx(index,2) = 1 !index: j - p%Jac_u_indx(index,3) = 1 !Node: i - index = index + 1 - end do - end if ! .not. p%CompAeroMaps - - !................ - ! input perturbations, du: - !................ - call AllocAry(p%du, 19, 'p%du', ErrStat2, ErrMsg2) ! 19 = number of unique values in p%Jac_u_indx(:,1) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - ! p%TipRad is set to 0 for BeamDyn simulations, so we're using a copy of the value from the input file here + ! Calculate values used for input perturbations + ! p%TipRad is set to 0 for BeamDyn simulations, so we're using a copy of the value from the input file here ScaleLength = max(p%TipRad, p%TowerHt, 1.0_ReKi) MaxThrust = 490.0_R8Ki * pi_D / 9.0_R8Ki * ScaleLength**2 MaxTorque = 122.5_R8Ki * pi_D / 27.0_R8Ki * ScaleLength**3 - - if (allocated(u%BladePtLoads)) then - do k=1,p%NumBl - p%du(2*k-1) = MaxThrust / real(100*p%NumBl*u%BladePtLoads(k)%NNodes,R8Ki) ! u%BladePtLoads(k)%Force = 2*k-1 - p%du(2*k ) = MaxTorque / real(100*p%NumBl*u%BladePtLoads(k)%NNodes,R8Ki) ! u%BladePtLoads(k)%Moment = 2*k - end do !k - else - p%du(1:6) = 0.0_R8Ki - end if - - p%du( 7) = MaxThrust / 100.0_R8Ki ! u%PlatformPtMesh%Force = 7 - p%du( 8) = MaxTorque / 100.0_R8Ki ! u%PlatformPtMesh%Moment = 8 - p%du( 9) = MaxThrust / real(100*u%TowerPtLoads%NNodes,R8Ki) ! u%TowerPtLoads%Force = 9 - p%du(10) = MaxTorque / real(100*u%TowerPtLoads%NNodes,R8Ki) ! u%TowerPtLoads%Moment = 10 - p%du(11) = MaxThrust / 100.0_R8Ki ! u%HubPtLoad%Force = 11 - p%du(12) = MaxTorque / 100.0_R8Ki ! u%HubPtLoad%Moment = 12 - p%du(13) = MaxThrust / 100.0_R8Ki ! u%NacelleLoads%Force = 13 - p%du(14) = MaxTorque / 100.0_R8Ki ! u%NacelleLoads%Moment = 14 - p%du(15) = MaxThrust / 100.0_R8Ki ! u%TFinCMLoads%Force = 15 - p%du(16) = MaxTorque / 100.0_R8Ki ! u%TFinCMLoads%Moment = 16 - p%du(17) = 2.0_R8Ki * D2R_D ! u%BlPitchCom = 17 - p%du(18) = MaxTorque / 100.0_R8Ki ! u%YawMom = 18 - p%du(19) = MaxTorque / (100.0_R8Ki*p%GBRatio) ! u%GenTrq = 19 - - !Set some limits in case perturbation is very small - do i=1,size(p%du) - p%du(i) = max(p%du(i), MinPerturb) - end do - !................ - ! names of the columns, InitOut%LinNames_u: - !................ - call AllocAry(InitOut%LinNames_u, nu+p%NumExtendedInputs, 'LinNames_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%RotFrame_u, nu+p%NumExtendedInputs, 'RotFrame_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%IsLoad_u, nu+p%NumExtendedInputs, 'IsLoad_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - InitOut%IsLoad_u = .true. ! most of ED's inputs are loads; we will override the non-load inputs below. - InitOut%RotFrame_u = .false. - index = 1 + ! Blade Point Loads if (allocated(u%BladePtLoads)) then - index_last = index - do k=1,p%NumBl_Lin - call PackLoadMesh_Names(u%BladePtLoads(k), 'Blade '//trim(num2lstr(k)), InitOut%LinNames_u, index) - end do - !InitOut%RotFrame_u(index_last:index-1) = .true. ! values on the mesh are in global, not rotating frame - end if - if (.not. p%CompAeroMaps) then - call PackLoadMesh_Names(u%PlatformPtMesh, 'Platform', InitOut%LinNames_u, index) - call PackLoadMesh_Names(u%TowerPtLoads, 'Tower', InitOut%LinNames_u, index) - call PackLoadMesh_Names(u%HubPtLoad, 'Hub', InitOut%LinNames_u, index) - call PackLoadMesh_Names(u%NacelleLoads, 'Nacelle', InitOut%LinNames_u, index) - call PackLoadMesh_Names(u%TFinCMLoads, 'Tailfin', InitOut%LinNames_u, index) - - do k = 1,p%NumBl ! scalars - InitOut%LinNames_u(index) = 'Blade '//trim(num2lstr(k))//' pitch command, rad' - InitOut%IsLoad_u( index) = .false. - InitOut%RotFrame_u(index) = .true. - index = index + 1 + do i = 1, p%NumBl + Flags = VF_None + if (i == 1) Flags = ior(Flags, VF_AeroMap) + call MV_AddMeshVar(Vars%u, "Blade "//Num2LStr(i), LoadFields, & + DL=DatLoc(ED_u_BladePtLoads, i), & + Mesh=u%BladePtLoads(i), & + Flags=Flags, & + Perturbs=[MaxThrust / (100.0_R8Ki*p%NumBl*p%BldNodes), & + MaxTorque / (100.0_R8Ki*p%NumBl*p%BldNodes)]) end do - - InitOut%LinNames_u(index) = 'Yaw moment, Nm' ; index = index + 1 - InitOut%LinNames_u(index) = 'Generator torque, Nm' ; index = index + 1 - InitOut%LinNames_u(index) = 'Extended input: collective blade-pitch command, rad' - InitOut%IsLoad_u( index) = .false. end if - -END SUBROUTINE ED_Init_Jacobian -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine elastodyn::ed_init_jacobian is consistant with this routine! -SUBROUTINE ED_Perturb_u( p, n, perturb_sign, u, du ) - - TYPE(ED_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(ED_InputType) , INTENT(INOUT) :: u !< perturbed ED inputs - REAL( R8Ki ) , INTENT( OUT) :: du !< amount that specific input was perturbed - - ! local variables - INTEGER :: fieldIndx - INTEGER :: node - - - fieldIndx = p%Jac_u_indx(n,2) - node = p%Jac_u_indx(n,3) - - du = p%du( p%Jac_u_indx(n,1) ) - - ! determine which mesh we're trying to perturb and perturb the input: - SELECT CASE( p%Jac_u_indx(n,1) ) - - ! BladePtLoads - ! Module/Mesh/Field: u%BladePtLoads(1)%Force = 1 - ! Module/Mesh/Field: u%BladePtLoads(1)%Moment = 2 - ! Module/Mesh/Field: u%BladePtLoads(2)%Force = 3 - ! Module/Mesh/Field: u%BladePtLoads(2)%Moment = 4 - ! Module/Mesh/Field: u%BladePtLoads(3)%Force = 5 - ! Module/Mesh/Field: u%BladePtLoads(3)%Moment = 6 - CASE ( 1); u%BladePtLoads(1)%Force( fieldIndx,node) = u%BladePtLoads(1)%Force( fieldIndx,node) + du * perturb_sign - CASE ( 2); u%BladePtLoads(1)%Moment(fieldIndx,node) = u%BladePtLoads(1)%Moment(fieldIndx,node) + du * perturb_sign - CASE ( 3); u%BladePtLoads(2)%Force( fieldIndx,node) = u%BladePtLoads(2)%Force( fieldIndx,node) + du * perturb_sign - CASE ( 4); u%BladePtLoads(2)%Moment(fieldIndx,node) = u%BladePtLoads(2)%Moment(fieldIndx,node) + du * perturb_sign - CASE ( 5); u%BladePtLoads(3)%Force( fieldIndx,node) = u%BladePtLoads(3)%Force( fieldIndx,node) + du * perturb_sign - CASE ( 6); u%BladePtLoads(3)%Moment(fieldIndx,node) = u%BladePtLoads(3)%Moment(fieldIndx,node) + du * perturb_sign - - ! PlatformPtMesh - ! Module/Mesh/Field: u%PlatformPtMesh%Force = 7 - ! Module/Mesh/Field: u%PlatformPtMesh%Moment = 8 - CASE ( 7); u%PlatformPtMesh%Force( fieldIndx,node) = u%PlatformPtMesh%Force( fieldIndx,node) + du * perturb_sign - CASE ( 8); u%PlatformPtMesh%Moment(fieldIndx,node) = u%PlatformPtMesh%Moment(fieldIndx,node) + du * perturb_sign - - ! TowerPtLoads - ! Module/Mesh/Field: u%TowerPtLoads%Force = 9 - ! Module/Mesh/Field: u%TowerPtLoads%Moment = 10 - CASE ( 9); u%TowerPtLoads%Force( fieldIndx,node) = u%TowerPtLoads%Force( fieldIndx,node) + du * perturb_sign - CASE (10); u%TowerPtLoads%Moment(fieldIndx,node) = u%TowerPtLoads%Moment(fieldIndx,node) + du * perturb_sign - - ! HubPtLoad - ! Module/Mesh/Field: u%HubPtLoad%Force = 11 - ! Module/Mesh/Field: u%HubPtLoad%Moment = 12 - CASE (11); u%HubPtLoad%Force( fieldIndx,node) = u%HubPtLoad%Force( fieldIndx,node) + du * perturb_sign - CASE (12); u%HubPtLoad%Moment(fieldIndx,node) = u%HubPtLoad%Moment(fieldIndx,node) + du * perturb_sign - - ! NacelleLoads - ! Module/Mesh/Field: u%NacelleLoads%Force = 13 - ! Module/Mesh/Field: u%NacelleLoads%Moment = 14 - CASE (13); u%NacelleLoads%Force( fieldIndx,node) = u%NacelleLoads%Force( fieldIndx,node) + du * perturb_sign - CASE (14); u%NacelleLoads%Moment(fieldIndx,node) = u%NacelleLoads%Moment(fieldIndx,node) + du * perturb_sign - - ! TFinCMLoads - ! Module/Mesh/Field: u%TFinCMLoads%Force = 15 - ! Module/Mesh/Field: u%TFinCMLoads%Moment = 16 - CASE (15); u%TFinCMLoads%Force( fieldIndx,node) = u%TFinCMLoads%Force( fieldIndx,node) + du * perturb_sign - CASE (16); u%TFinCMLoads%Moment(fieldIndx,node) = u%TFinCMLoads%Moment(fieldIndx,node) + du * perturb_sign - - ! Controller inputs - ! Module/Mesh/Field: u%BlPitchCom = 17 - ! Module/Mesh/Field: u%YawMom = 18 - ! Module/Mesh/Field: u%GenTrq = 19 - CASE (17); u%BlPitchCom(node) = u%BlPitchCom(node) + du * perturb_sign - CASE (18); u%YawMom = u%YawMom + du * perturb_sign - CASE (19); u%GenTrq = u%GenTrq + du * perturb_sign - - END SELECT - -END SUBROUTINE ED_Perturb_u -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the continuous state array. -!! Do not change this without making sure subroutine elastodyn::ed_init_jacobian is consistant with this routine! -SUBROUTINE ED_Perturb_x( p, n_in, perturb_sign, x, dx ) - - TYPE(ED_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n_in !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(ED_ContinuousStateType) , INTENT(INOUT) :: x !< perturbed ED states - REAL( R8Ki ) , INTENT( OUT) :: dx !< amount that specific state was perturbed - - - ! local variables - integer(intKi) :: indx - integer(intKi) :: n - - n = (n_in - 1) * p%NActvDOF_Stride + 1 - - if (n > p%DOFs%NActvDOF) then - - indx = p%DOFs%PS(n-p%DOFs%NActvDOF) - dx = p%dx( indx ) + ! Platform point loads + call MV_AddMeshVar(Vars%u, "Platform", LoadFields, & + DL=DatLoc(ED_u_PlatformPtMesh), & + Mesh=u%PlatformPtMesh, & + Perturbs=[MaxThrust / 100.0_R8Ki, & + MaxTorque / 100.0_R8Ki]) + ! Tower point loads + call MV_AddMeshVar(Vars%u, "Tower", LoadFields, & + DL=DatLoc(ED_u_TowerPtLoads), & + Mesh=u%TowerPtLoads, & + Perturbs=[MaxThrust / (100.0_R8Ki*p%NumBl*p%TwrNodes), & + MaxTorque / (100.0_R8Ki*p%NumBl*p%TwrNodes)]) + ! Hub point loads + call MV_AddMeshVar(Vars%u, "Hub", LoadFields, & + DL=DatLoc(ED_u_HubPtLoad), & + Mesh=u%HubPtLoad, & + Perturbs=[MaxThrust / 100.0_R8Ki, & + MaxTorque / 100.0_R8Ki]) + ! Nacelle point loads + call MV_AddMeshVar(Vars%u, "Nacelle", LoadFields, & + DL=DatLoc(ED_u_NacelleLoads), & + Mesh=u%NacelleLoads, & + Perturbs=[MaxThrust / 100.0_R8Ki, & + MaxTorque / 100.0_R8Ki]) + + ! TFinCM point loads + call MV_AddMeshVar(Vars%u, "Tailfin", LoadFields, & + DL=DatLoc(ED_u_TFinCMLoads), & + Mesh=u%TFinCMLoads, & + Perturbs=[MaxThrust / 100.0_R8Ki, & + MaxTorque / 100.0_R8Ki]) + + ! Non-mesh input variables + call MV_AddVar(Vars%u, "BlPitchCom", FieldScalar, & + DL=DatLoc(ED_u_BlPitchCom), iAry=1, & + Num=p%NumBl, & + Flags=VF_RotFrame + VF_Linearize + VF_2PI, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=[('Blade '//trim(num2lstr(i))//' pitch command, rad', i=1,p%NumBl)]) + + call MV_AddVar(Vars%u, "YawMom", FieldScalar, & + DL=DatLoc(ED_u_YawMom), & + Flags=VF_Linearize, & + Perturb=MaxTorque / 100.0_R8Ki, & + LinNames=['Yaw moment, Nm']) + + call MV_AddVar(Vars%u, "GenTrq", FieldScalar, & + DL=DatLoc(ED_u_GenTrq), & + Flags=VF_Linearize, & + Perturb=MaxTorque / (100.0_R8Ki*p%GBRatio), & + LinNames=['Generator torque, Nm']) + + call MV_AddVar(Vars%u, "BlPitchComC", FieldScalar, & + DL=DatLoc(ED_u_BlPitchComC), & + Flags=VF_ExtLin + VF_Linearize + VF_2PI, & + LinNames=['Extended input: collective blade-pitch command, rad']) + + ! Set minimum input perturbations + do i = 1,size(Vars%u) + Vars%u(i)%Perturb = max(Vars%u(i)%Perturb, MinPerturb) + end do - x%QDT( indx ) = x%QDT( indx ) + dx * perturb_sign - - else - - indx = p%DOFs%PS(n) - dx = p%dx( indx ) - - x%QT( indx ) = x%QT( indx ) + dx * perturb_sign - end if - -END SUBROUTINE ED_Perturb_x -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine elastodyn::ed_init_jacobian is consistant with this routine! -SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) - - TYPE(ED_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(ED_OutputType) , INTENT(IN ) :: y_p !< ED outputs at \f$ u + \Delta u \f$ or \f$ x + \Delta x \f$ (p=plus) - TYPE(ED_OutputType) , INTENT(IN ) :: y_m !< ED outputs at \f$ u - \Delta u \f$ or \f$ x - \Delta x \f$ (m=minus) - REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta = \Delta u \f$ or \f$ delta = \Delta x \f$ - REAL(R8Ki) , INTENT(INOUT) :: dY(:) !< column of dYdu or dYdx: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial x_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ - - ! local variables: - INTEGER(IntKi) :: k ! loop over blades - INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled - LOGICAL :: Mask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing - - - indx_first = 1 - if (allocated(y_p%BladeLn2Mesh)) then - Mask = .true. - if (p%CompAeroMaps) then - Mask(MASKID_TRANSLATIONACC) = .false. - Mask(MASKID_ROTATIONACC) = .false. - end if - - do k=1,p%NumBl_Lin - call PackMotionMesh_dY(y_p%BladeLn2Mesh(k), y_m%BladeLn2Mesh(k), dY, indx_first, FieldMask=Mask) + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + if (allocated(y%BladeLn2Mesh))then + do i = 1, p%NumBl + Flags = VF_None + if (i == 1) Flags = ior(Flags, VF_AeroMap) + call MV_AddMeshVar(Vars%y, 'Blade '//Num2LStr(i), [FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel], & + DatLoc(ED_y_BladeLn2Mesh, i), & + Flags=Flags, & + Mesh=y%BladeLn2Mesh(i)) + call MV_AddMeshVar(Vars%y, 'Blade '//Num2LStr(i), [FieldTransAcc, FieldAngularAcc], & + DatLoc(ED_y_BladeLn2Mesh, i), & + Mesh=y%BladeLn2Mesh(i)) end do - end if - - if (.not. p%CompAeroMaps) then - call PackMotionMesh_dY(y_p%PlatformPtMesh, y_m%PlatformPtMesh, dY, indx_first, UseSmlAngle=.false.) ! all fields - call PackMotionMesh_dY(y_p%TowerLn2Mesh, y_m%TowerLn2Mesh, dY, indx_first, UseSmlAngle=.false.) ! all fields - - Mask = .false. - Mask(MASKID_TRANSLATIONDISP) = .true. - Mask(MASKID_ORIENTATION) = .true. - Mask(MASKID_ROTATIONVEL) = .true. - call PackMotionMesh_dY(y_p%HubPtMotion, y_m%HubPtMotion, dY, indx_first, FieldMask=Mask) - - do k=1,p%NumBl_Lin - call PackMotionMesh_dY(y_p%BladeRootMotion(k), y_m%BladeRootMotion(k), dY, indx_first) - end do - call PackMotionMesh_dY(y_p%NacelleMotion, y_m%NacelleMotion, dY, indx_first) - - Mask = .false. - Mask(MASKID_TRANSLATIONDISP) = .true. - Mask(MASKID_ORIENTATION) = .true. - Mask(MASKID_TRANSLATIONVEL) = .true. - Mask(MASKID_ROTATIONVEL) = .true. - call PackMotionMesh_dY(y_p%TFinCMMotion, y_m%TFinCMMotion, dY, indx_first, FieldMask=Mask) - - dY(indx_first) = y_p%Yaw - y_m%Yaw; indx_first = indx_first + 1 - dY(indx_first) = y_p%YawRate - y_m%YawRate; indx_first = indx_first + 1 - 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 + p%BldNd_TotNumOuts - dY(k+indx_first-1) = y_p%WriteOutput(k) - y_m%WriteOutput(k) - end do - end if - - dY = dY / (2.0_R8Ki*delta) - -END SUBROUTINE Compute_dY -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two continuous state types to compute an array of differences. -!! Do not change this packing without making sure subroutine elastodyn::init_jacobian is consistant with this routine! -SUBROUTINE Compute_dX(p, x_p, x_m, delta, dX) - - TYPE(ED_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(ED_ContinuousStateType) , INTENT(IN ) :: x_p !< ED continuous states at \f$ u + \Delta_p u \f$ or \f$ x + \Delta_p x \f$ (p=plus) - TYPE(ED_ContinuousStateType) , INTENT(IN ) :: x_m !< ED continuous states at \f$ u - \Delta_m u \f$ or \f$ x - \Delta_m x \f$ (m=minus) - REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta = \Delta u \f$ or \f$ delta = \Delta_p x \f$ - REAL(R8Ki) , INTENT(INOUT) :: dX(:) !< column of dXdu or dXdx: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial x_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ - - ! local variables: - INTEGER(IntKi) :: i ! loop over blade nodes - INTEGER(IntKi) :: j ! loop over blades - INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled - - indx_first = 0 - - if (p%NActvVelDOF_Lin > 0) then - do j=1,p%DOFs%NActvDOF, p%NActvDOF_Stride ! Loop through all active (enabled) DOFs for linearization - indx_first = indx_first + 1 - dX(indx_first) = x_p%QT( p%DOFs%PS(j) ) - x_m%QT( p%DOFs%PS(j) ) - end do - end if - - do j=1,p%DOFs%NActvDOF, p%NActvDOF_Stride ! Loop through all active (enabled) DOFs for linearization - indx_first = indx_first + 1 - dX(indx_first) = x_p%QDT( p%DOFs%PS(j) ) - x_m%QDT( p%DOFs%PS(j) ) + end if + + call MV_AddMeshVar(Vars%y, 'Platform', MotionFields, & + DatLoc(ED_y_PlatformPtMesh), & + Mesh=y%PlatformPtMesh, & + Flags=VF_SmallAngle) + + call MV_AddMeshVar(Vars%y, 'Tower', MotionFields, & + DatLoc(ED_y_TowerLn2Mesh), & + Mesh=y%TowerLn2Mesh, & + Flags=ior(VF_Line, VF_SmallAngle)) + + call MV_AddMeshVar(Vars%y, 'Hub', [FieldTransDisp, FieldOrientation, FieldAngularVel], & + DatLoc(ED_y_HubPtMotion), & + Mesh=y%HubPtMotion) + + do i = 1, p%NumBl + call MV_AddMeshVar(Vars%y, 'Blade root '//Num2LStr(i), MotionFields, & + DatLoc(ED_y_BladeRootMotion, i), & + Mesh=y%BladeRootMotion(i)) end do - - dX = dX / (2*delta) ! whole array operation - -END SUBROUTINE Compute_dX -!---------------------------------------------------------------------------------------------------------------------------------- -!> 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, NeedTrimOP ) - - 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) - TYPE(ED_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(ED_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(ED_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(ED_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(ED_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(ED_OutputType), INTENT(IN ) :: y !< Output at operating point - TYPE(ED_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - LOGICAL, OPTIONAL, INTENT(IN ) :: NeedTrimOP !< whether a y_op values should contain values for trim solution (3-value representation instead of full orientation matrices, no rotation acc) + call MV_AddMeshVar(Vars%y, 'Nacelle', MotionFields, & + DatLoc(ED_y_NacelleMotion), & + Mesh=y%NacelleMotion) + + call MV_AddMeshVar(Vars%y, 'TailFin', [FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel], & + DatLoc(ED_y_TFinCMMotion), & + Mesh=y%TFinCMMotion) + + call MV_AddVar(Vars%y, 'Yaw', FieldScalar, & + DatLoc(ED_y_Yaw), & + Flags=VF_2PI, & + LinNames=['Yaw, rad']) + + call MV_AddVar(Vars%y, 'YawRate', FieldScalar, & + DatLoc(ED_y_YawRate), & + LinNames=['YawRate, rad/s']) + + call MV_AddVar(Vars%y, 'HSS_Spd', FieldScalar, & + DatLoc(ED_y_HSS_Spd), & + LinNames=['HSS_Spd, rad/s']) + + ! Write output variables + do i = 1, p%NumOuts + call MV_AddVar(Vars%y, p%OutParam(i)%Name, FieldScalar, & + DatLoc(ED_y_WriteOutput), iAry=i, & + Flags=VF_WriteOut + OutParamFlags(p%OutParam(i)%Indx), & + LinNames=[trim(p%OutParam(i)%Name)//', '//trim(p%OutParam(i)%Units)], & + Active=(p%OutParam(i)%Indx > 0)) + end do + k = p%NumOuts + 1 + do i = 1, p%BldNd_NumOuts + do j = 1, p%BldNd_BladesOut + call MV_AddVar(Vars%y, p%BldNd_OutParam(i)%Name, FieldScalar, & + DatLoc(ED_y_WriteOutput), iAry=k, & + Num=p%BldNodes, & + Flags=VF_WriteOut + VF_RotFrame, & + LinNames=[(BldOutLinName(p%BldNd_OutParam(i), j, k), k=1, p%BldNodes)], & + Active=(p%BldNd_OutParam(i)%Indx > 0)) + k = k + p%BldNodes + end do + end do + !---------------------------------------------------------------------------- + ! Initialization dependent on linearization + !---------------------------------------------------------------------------- - INTEGER(IntKi) :: i, k, index - INTEGER(IntKi) :: ny - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_GetOP' - LOGICAL :: ReturnTrimOP - 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 - - - ! Initialize ErrStat + call MV_InitVarsJac(Vars, m%Jac, Linearize .or. p%CompAeroMaps, ErrStat2, ErrMsg2); if (Failed()) return - ErrStat = ErrID_None - ErrMsg = '' - - !.................................. - IF ( PRESENT( u_op ) ) THEN - if (.not. allocated(u_op)) then - call AllocAry(u_op, size(p%Jac_u_indx,1)+p%NumExtendedInputs,'u_op',ErrStat2,ErrMsg2) ! +1 for extended input here - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - end if - - index = 1 - if (allocated(u%BladePtLoads)) then - do k=1,p%NumBl_Lin - call PackLoadMesh(u%BladePtLoads(k), u_op, index) - end do - end if - if (.not. p%CompAeroMaps) then - call PackLoadMesh(u%PlatformPtMesh, u_op, index) - call PackLoadMesh(u%TowerPtLoads, u_op, index) - call PackLoadMesh(u%HubPtLoad, u_op, index) - call PackLoadMesh(u%NacelleLoads, u_op, index) - call PackLoadMesh(u%TFinCMLoads, u_op, index) - - do k = 1,p%NumBl_Lin ! scalars - u_op(index) = u%BlPitchCom(k) - index = index + 1 - end do - u_op(index) = u%YawMom ; index = index + 1 - u_op(index) = u%GenTrq ; index = index + 1 - - ! extended input: ! note this happens only if .not. p%CompAeroMaps, so p%NumExtendedInputs > 0 - u_op(index) = u%BlPitchCom(1) - - do k = 2,p%NumBl_Lin - if (.not. EqualRealNos( u%BlPitchCom(1), u%BlPitchCom(k) ) ) then - call SetErrStat(ErrID_Info,"Operating point of collective pitch extended input is invalid because "// & - "the commanded blade pitch angles are not the same for each blade.", ErrStat, ErrMsg, RoutineName) - exit - end if - end do - end if - - END IF - - !.................................. - IF ( PRESENT( y_op ) ) THEN - if (present(NeedTrimOP)) then - ReturnTrimOP = NeedTrimOP - else - ReturnTrimOP = .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 - if (p%CompAeroMaps) then - ny = p%Jac_ny - else - ny = p%Jac_ny + y%PlatformPtMesh%NNodes * 6 & ! Jac_ny has 3 for Orientation, but we need 9 at each node - + y%TowerLn2Mesh%NNodes * 6 & ! Jac_ny has 3 for Orientation, but we need 9 at each node - + y%HubPtMotion%NNodes * 6 & ! Jac_ny has 3 for Orientation, but we need 9 at each node - + y%NacelleMotion%NNodes * 6 & ! Jac_ny has 3 for Orientation, but we need 9 at each node - + y%TFinCMMotion%NNodes * 6 ! Jac_ny has 3 for Orientation, but we need 9 at each node - - do k=1,p%NumBl_Lin - ny = ny + y%BladeRootMotion(k)%NNodes * 6 ! Jac_ny has 3 for Orientation, but we need 9 at each node on each blade - end do - - end if - - if (allocated(y%BladeLn2Mesh)) then - do k=1,p%NumBl_Lin - ny = ny + y%BladeLn2Mesh(k)%NNodes * 6 ! Jac_ny has 3 for Orientation, but we need 9 (at each node on each blade) - end do - end if - - call AllocAry(y_op, ny,'y_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - end if - - if (ReturnTrimOP) y_op = 0.0_ReKi ! initialize in case we are returning packed orientations and don't fill the entire array + if (Linearize .or. p%CompAeroMaps) then + call ED_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ED_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ED_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ED_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + end if - - if ( p%CompAeroMaps ) then - Mask = .false. - Mask(MASKID_TRANSLATIONDISP) = .true. - Mask(MASKID_ORIENTATION) = .true. - Mask(MASKID_TRANSLATIONVEL) = .true. - Mask(MASKID_ROTATIONVEL) = .true. +contains + function BldOutLinName(OutParam, iBlade, iNode) result(Name) + integer(IntKi), intent(in) :: iBlade, iNode + type(OutParmType), intent(in) :: OutParam + character(LinChanLen) :: Name + write(Name, '("B",I1.1,"N",I3.3,A,", ",A)') iBlade, iNode, trim(OutParam%Name), trim(OutParam%Units) + end function + function OutParamFlags(indx) result(flagsRes) + integer(IntKi), intent(in) :: indx + integer(IntKi) :: flagsRes + integer(IntKi), parameter :: RotatingFrameIndices(*) = [& + TipDxc, TipDyc, TipDzc, TipDxb, TipDyb, & + TipALxb, TipALyb, TipALzb, TipRDxb, TipRDyb, TipRDzc, TipClrnc, & + PtchPMzc, & + RootFxc, RootFyc, RootFzc, RootFxb, RootFyb, & + RootMxc, RootMyc, RootMzc, RootMxb, RootMyb, & + SpnALxb, SpnALyb, SpnALzb, SpnFLxb, SpnFLyb, SpnFLzb, & + SpnMLxb, SpnMLyb, SpnMLzb, SpnTDxb, SpnTDyb, SpnTDzb, & + SpnRDxb, SpnRDyb, SpnRDzb] + if (any(RotatingFrameIndices == indx)) then + flagsRes = VF_RotFrame else - Mask = .true. - end if - - index = 1 - if (allocated(y%BladeLn2Mesh)) then - do k=1,p%NumBl_Lin - call PackMotionMesh(y%BladeLn2Mesh(k), y_op, index, FieldMask=Mask, TrimOP=ReturnTrimOP) - end do - end if - if (.not. p%CompAeroMaps) then - call PackMotionMesh(y%PlatformPtMesh, y_op, index, TrimOP=ReturnTrimOP) - call PackMotionMesh(y%TowerLn2Mesh, y_op, index, TrimOP=ReturnTrimOP) - - Mask = .false. - Mask(MASKID_TRANSLATIONDISP) = .true. - Mask(MASKID_ORIENTATION) = .true. - Mask(MASKID_ROTATIONVEL) = .true. - call PackMotionMesh(y%HubPtMotion, y_op, index, FieldMask=Mask, TrimOP=ReturnTrimOP) - - do k=1,p%NumBl_Lin - call PackMotionMesh(y%BladeRootMotion(k), y_op, index, TrimOP=ReturnTrimOP) - end do - call PackMotionMesh(y%NacelleMotion, y_op, index, TrimOP=ReturnTrimOP) - - Mask = .false. - Mask(MASKID_TRANSLATIONDISP) = .true. - Mask(MASKID_ORIENTATION) = .true. - Mask(MASKID_TRANSLATIONVEL) = .true. - Mask(MASKID_ROTATIONVEL) = .true. - call PackMotionMesh(y%TFinCMMotion, y_op, index, FieldMask=Mask, TrimOP=ReturnTrimOP) - - 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 + p%BldNd_TotNumOuts - y_op(i+index) = y%WriteOutput(i) - end do - end if - - END IF - - !.................................. - IF ( PRESENT( x_op ) ) THEN - - if (.not. allocated(x_op)) then - call AllocAry(x_op, p%NActvDOF_Lin + p%NActvVelDOF_Lin,'x_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - end if - - index = 0 - do i=1,p%DOFs%NActvDOF,p%NActvDOF_Stride ! Loop through all active (enabled) DOFs in the Jacobian - index = index + 1 - x_op(index) = x%QT( p%DOFs%PS(i) ) - end do - - if (p%NActvVelDOF_Lin > 0) then ! .not. p%CompAeroMaps - do i=1,p%DOFs%NActvDOF,p%NActvDOF_Stride ! Loop through all active (enabled) DOFs in the Jacobian - index = index + 1 - x_op(index) = x%QDT( p%DOFs%PS(i) ) - end do + flagsRes = VF_None end if - - END IF - - !.................................. - IF ( PRESENT( dx_op ) ) THEN - - if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%NActvDOF_Lin + p%NActvVelDOF_Lin,'dx_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - end if - - call ED_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dx, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call ED_DestroyContState( dx, ErrStat2, ErrMsg2) - return - end if - - index = 0 - if (p%NActvVelDOF_Lin > 0) then ! p%CompAeroMaps - do i=1,p%DOFs%NActvDOF,p%NActvDOF_Stride ! Loop through all active (enabled) DOFs in the Jacobian - index = index + 1 - dx_op(index) = dx%QT( p%DOFs%PS(i) ) - end do - end if - - do i=1,p%DOFs%NActvDOF,p%NActvDOF_Stride ! Loop through all active (enabled) DOFs in the Jacobian - index = index + 1 - dx_op(index) = dx%QDT( p%DOFs%PS(i) ) - end do - - call ED_DestroyContState( dx, ErrStat2, ErrMsg2) - - END IF - - !.................................. - IF ( PRESENT( xd_op ) ) THEN - END IF - - !.................................. - IF ( PRESENT( z_op ) ) THEN - END IF - -END SUBROUTINE ED_GetOP -!---------------------------------------------------------------------------------------------------------------------------------- - + end function + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine END MODULE ElastoDyn !********************************************************************************************************************************** diff --git a/modules/elastodyn/src/ElastoDyn_Registry.txt b/modules/elastodyn/src/ElastoDyn_Registry.txt index 2210e9b573..aa916ebb11 100644 --- a/modules/elastodyn/src/ElastoDyn_Registry.txt +++ b/modules/elastodyn/src/ElastoDyn_Registry.txt @@ -14,7 +14,7 @@ include Registry_NWTC_Library.txt # ElastoDyn Constants param ElastoDyn/ED - IntKi ED_NMX - 4 - "Used in updating predictor-corrector values (size of state history)" - - +param ^ - IntKi ED_u_BlPitchComC - -1 - "DatLoc number for collective blade pitch extended input" - # ..... Initialization data ....................................................................................................... # Define inputs that the initialization routine may need here: @@ -58,6 +58,7 @@ typedef ^ InitOutputType IntKi DerivOrder_x {:} - - "Integer that tells FAST/MBC typedef ^ InitOutputType LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - typedef ^ InitOutputType LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - typedef ^ InitOutputType IntKi GearBox_index - - - "Index to gearbox rotation in state array (for steady-state calculations)" - +typedef ^ InitOutputType ModVarsType Vars - - - "Module Variables" # ..... Blade Input file data ........................................................................................................... typedef ElastoDyn/ED BladeInputData IntKi NBlInpSt - - - "Number of blade input stations" - @@ -537,40 +538,10 @@ typedef ^ OtherStateType ReKi YawFriMfp - - - "Y typedef ^ OtherStateType R8Ki OmegaTn - - - "Yaw rate at t_n used to calculate friction torque and yaw rate at t_n+1" rad/s typedef ^ OtherStateType R8Ki OmegaDotTn - - - "Yaw acceleration at t_n used to calculate friction torque and yaw rate at t_n+1" rad/s^2 -# ..... Misc Vars ................................................................................................................ -typedef ^ MiscVarType ED_CoordSys CoordSys - - - "Coordinate systems in the FAST framework" - -typedef ^ MiscVarType ED_RtHndSide RtHS - - - "Values used in calculating the right-hand-side RtHS (and outputs)" -typedef ^ MiscVarType ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" "see OutListParameters.xlsx spreadsheet" -typedef ^ MiscVarType R8Ki AugMat {:}{:} - - "The augmented matrix used for the solution of the QD2T()s" -typedef ^ MiscVarType R8Ki AugMat_factor {:}{:} - - "factored version of AugMat matrix" -typedef ^ MiscVarType R8Ki SolnVec {:} - - "b in the equation Ax=b (last column of AugMat)" -typedef ^ MiscVarType IntKi AugMat_pivot {:} - - "Pivot column for AugMat in LAPACK factorization" -typedef ^ MiscVarType ReKi OgnlGeAzRo {:} - - "Original DOF_GeAz row in AugMat" - -typedef ^ MiscVarType R8Ki QD2T {:} - - "Solution (acceleration) vector; the first time derivative of QDT" -typedef ^ MiscVarType Logical IgnoreMod - - - "whether to ignore the modulo in ED outputs (necessary for linearization perturbations)" - -typedef ^ MiscVarType ReKi OgnlYawRow {:} - - "Original DOF_Yaw row in AugMat" - -typedef ^ MiscVarType ReKi FrcONcRt 3 - - "Force acting on yaw bearing including inertial contributions" N -typedef ^ MiscVarType ReKi MomONcRt 3 - - "Moment acting on yaw bearing including inertial contributions" N-m -typedef ^ MiscVarType ReKi YawFriMz - - - "External loading on yaw bearing not including inertial contributions" N-m # ..... Parameters ................................................................................................................ # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: -typedef ^ Jac_u_idxStarts IntKi BladeLoad - 1 - "Index to first point in y jacobian for BladeLoad" - -typedef ^ Jac_u_idxStarts IntKi PlatformLoad - 1 - "Index to first point in y jacobian for PlatformLoad" - -typedef ^ Jac_u_idxStarts IntKi TowerLoad - 1 - "Index to first point in y jacobian for TowerLoad" - -typedef ^ Jac_u_idxStarts IntKi HubLoad - 1 - "Index to first point in y jacobian for HubLoad" - -typedef ^ Jac_u_idxStarts IntKi NacelleLoad - 1 - "Index to first point in y jacobian for NacelleLoad" - -typedef ^ Jac_u_idxStarts IntKi TFinLoad - 1 - "Index to first point in y jacobian for TFinLoad" - -typedef ^ Jac_u_idxStarts IntKi BlPitchCom - 1 - "Index to first point in y jacobian for BlPitchCom" - -typedef ^ Jac_y_idxStarts IntKi Blade - 1 - "Index to first point in u jacobian for Blade" - -typedef ^ Jac_y_idxStarts IntKi Platform - 1 - "Index to first point in u jacobian for Platform" - -typedef ^ Jac_y_idxStarts IntKi Tower - 1 - "Index to first point in u jacobian for Tower" - -typedef ^ Jac_y_idxStarts IntKi Hub - 1 - "Index to first point in u jacobian for Hub" - -typedef ^ Jac_y_idxStarts IntKi BladeRoot - 1 - "Index to first point in u jacobian for BladeRoot" - -typedef ^ Jac_y_idxStarts IntKi Nacelle - 1 - "Index to first point in u jacobian for Nacelle" - -typedef ^ Jac_y_idxStarts IntKi TFin - 1 - "Index to first point in u jacobian for TFin" - - typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds typedef ^ ParameterType DbKi DT24 - - - "=DT/24 (used in loose coupling)" seconds typedef ^ ParameterType IntKi BldNodes - - - "Number of blade nodes used in the analysis" - @@ -806,8 +777,6 @@ typedef ^ ParameterType OutParmType BldNd_OutParam {:} - - "Names and unit #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 Jac_u_idxStarts Jac_u_idxStartList - - - "Starting indices for all Jac_u compenents" - -typedef ^ ParameterType Jac_y_idxStarts Jac_y_idxStartList - - - "Starting indices for all Jac_u compenents" - 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)" @@ -874,3 +843,24 @@ typedef ^ OutputType ReKi RotPwr - - - "Rotor power (this is equivalent to the l typedef ^ OutputType ReKi LSShftFxa - - - "Rotating low-speed shaft force x" N typedef ^ OutputType ReKi LSShftFys - - - "Nonrotating low-speed shaft force y" N typedef ^ OutputType ReKi LSShftFzs - - - "Nonrotating low-speed shaft force z" N + +# ..... Misc Vars ................................................................................................................ +typedef ^ MiscVarType ED_CoordSys CoordSys - - - "Coordinate systems in the FAST framework" - +typedef ^ MiscVarType ED_RtHndSide RtHS - - - "Values used in calculating the right-hand-side RtHS (and outputs)" +typedef ^ MiscVarType ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" "see OutListParameters.xlsx spreadsheet" +typedef ^ MiscVarType R8Ki AugMat {:}{:} - - "The augmented matrix used for the solution of the QD2T()s" +typedef ^ MiscVarType R8Ki AugMat_factor {:}{:} - - "factored version of AugMat matrix" +typedef ^ MiscVarType R8Ki SolnVec {:} - - "b in the equation Ax=b (last column of AugMat)" +typedef ^ MiscVarType IntKi AugMat_pivot {:} - - "Pivot column for AugMat in LAPACK factorization" +typedef ^ MiscVarType ReKi OgnlGeAzRo {:} - - "Original DOF_GeAz row in AugMat" - +typedef ^ MiscVarType R8Ki QD2T {:} - - "Solution (acceleration) vector; the first time derivative of QDT" +typedef ^ MiscVarType Logical IgnoreMod - - - "whether to ignore the modulo in ED outputs (necessary for linearization perturbations)" - +typedef ^ MiscVarType ReKi OgnlYawRow {:} - - "Original DOF_Yaw row in AugMat" - +typedef ^ MiscVarType ReKi FrcONcRt 3 - - "Force acting on yaw bearing including inertial contributions" N +typedef ^ MiscVarType ReKi MomONcRt 3 - - "Moment acting on yaw bearing including inertial contributions" N-m +typedef ^ MiscVarType ReKi YawFriMz - - - "External loading on yaw bearing not including inertial contributions" N-m +typedef ^ MiscVarType ModJacType Jac - - - "Values corresponding to module variables" +typedef ^ MiscVarType ED_ContinuousStateType x_perturb - - - "" - +typedef ^ MiscVarType ED_ContinuousStateType dxdt_lin - - - "" - +typedef ^ MiscVarType ED_InputType u_perturb - - - "" - +typedef ^ MiscVarType ED_OutputType y_lin - - - "" - diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index adc0c3f8c8..a342e6c991 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -33,7 +33,8 @@ MODULE ElastoDyn_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: ED_NMX = 4 ! Used in updating predictor-corrector values (size of state history) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ED_NMX = 4 ! Used in updating predictor-corrector values (size of state history) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ED_u_BlPitchComC = -1 ! DatLoc number for collective blade pitch extended input [-] ! ========= ED_InitInputType ======= TYPE, PUBLIC :: ED_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file [-] @@ -78,6 +79,7 @@ MODULE ElastoDyn_Types LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] INTEGER(IntKi) :: GearBox_index = 0_IntKi !< Index to gearbox rotation in state array (for steady-state calculations) [-] + TYPE(ModVarsType) :: Vars !< Module Variables [-] END TYPE ED_InitOutputType ! ======================= ! ========= BladeInputData ======= @@ -545,46 +547,6 @@ MODULE ElastoDyn_Types REAL(R8Ki) :: OmegaDotTn = 0.0_R8Ki !< Yaw acceleration at t_n used to calculate friction torque and yaw rate at t_n+1 [rad/s^2] END TYPE ED_OtherStateType ! ======================= -! ========= ED_MiscVarType ======= - TYPE, PUBLIC :: ED_MiscVarType - TYPE(ED_CoordSys) :: CoordSys !< Coordinate systems in the FAST framework [-] - TYPE(ED_RtHndSide) :: RtHS !< Values used in calculating the right-hand-side RtHS (and outputs) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [see OutListParameters.xlsx spreadsheet] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: AugMat !< The augmented matrix used for the solution of the QD2T()s [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: AugMat_factor !< factored version of AugMat matrix [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: SolnVec !< b in the equation Ax=b (last column of AugMat) [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: AugMat_pivot !< Pivot column for AugMat in LAPACK factorization [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OgnlGeAzRo !< Original DOF_GeAz row in AugMat [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: QD2T !< Solution (acceleration) vector; the first time derivative of QDT [-] - LOGICAL :: IgnoreMod = .false. !< whether to ignore the modulo in ED outputs (necessary for linearization perturbations) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OgnlYawRow !< Original DOF_Yaw row in AugMat [-] - REAL(ReKi) , DIMENSION(1:3) :: FrcONcRt = 0.0_ReKi !< Force acting on yaw bearing including inertial contributions [N] - REAL(ReKi) , DIMENSION(1:3) :: MomONcRt = 0.0_ReKi !< Moment acting on yaw bearing including inertial contributions [N-m] - REAL(ReKi) :: YawFriMz = 0.0_ReKi !< External loading on yaw bearing not including inertial contributions [N-m] - END TYPE ED_MiscVarType -! ======================= -! ========= Jac_u_idxStarts ======= - TYPE, PUBLIC :: Jac_u_idxStarts - INTEGER(IntKi) :: BladeLoad = 1 !< Index to first point in y jacobian for BladeLoad [-] - INTEGER(IntKi) :: PlatformLoad = 1 !< Index to first point in y jacobian for PlatformLoad [-] - INTEGER(IntKi) :: TowerLoad = 1 !< Index to first point in y jacobian for TowerLoad [-] - INTEGER(IntKi) :: HubLoad = 1 !< Index to first point in y jacobian for HubLoad [-] - INTEGER(IntKi) :: NacelleLoad = 1 !< Index to first point in y jacobian for NacelleLoad [-] - INTEGER(IntKi) :: TFinLoad = 1 !< Index to first point in y jacobian for TFinLoad [-] - INTEGER(IntKi) :: BlPitchCom = 1 !< Index to first point in y jacobian for BlPitchCom [-] - END TYPE Jac_u_idxStarts -! ======================= -! ========= Jac_y_idxStarts ======= - TYPE, PUBLIC :: Jac_y_idxStarts - INTEGER(IntKi) :: Blade = 1 !< Index to first point in u jacobian for Blade [-] - INTEGER(IntKi) :: Platform = 1 !< Index to first point in u jacobian for Platform [-] - INTEGER(IntKi) :: Tower = 1 !< Index to first point in u jacobian for Tower [-] - INTEGER(IntKi) :: Hub = 1 !< Index to first point in u jacobian for Hub [-] - INTEGER(IntKi) :: BladeRoot = 1 !< Index to first point in u jacobian for BladeRoot [-] - INTEGER(IntKi) :: Nacelle = 1 !< Index to first point in u jacobian for Nacelle [-] - INTEGER(IntKi) :: TFin = 1 !< Index to first point in u jacobian for TFin [-] - END TYPE Jac_y_idxStarts -! ======================= ! ========= ED_ParameterType ======= TYPE, PUBLIC :: ED_ParameterType REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] @@ -814,8 +776,6 @@ MODULE ElastoDyn_Types INTEGER(IntKi) :: BldNd_TotNumOuts = 0_IntKi !< Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- ED_AllBldNdOuts) [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: BldNd_OutParam !< Names and units (and other characteristics) of all requested output parameters [-] INTEGER(IntKi) :: BldNd_BladesOut = 0_IntKi !< The blades to output (ED_AllBldNdOuts) [-] - TYPE(Jac_u_idxStarts) :: Jac_u_idxStartList !< Starting indices for all Jac_u compenents [-] - TYPE(Jac_y_idxStarts) :: Jac_y_idxStartList !< Starting indices for all Jac_u compenents [-] 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) [-] @@ -883,7 +843,81 @@ MODULE ElastoDyn_Types REAL(ReKi) :: LSShftFzs = 0.0_ReKi !< Nonrotating low-speed shaft force z [N] END TYPE ED_OutputType ! ======================= -CONTAINS +! ========= ED_MiscVarType ======= + TYPE, PUBLIC :: ED_MiscVarType + TYPE(ED_CoordSys) :: CoordSys !< Coordinate systems in the FAST framework [-] + TYPE(ED_RtHndSide) :: RtHS !< Values used in calculating the right-hand-side RtHS (and outputs) [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [see OutListParameters.xlsx spreadsheet] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: AugMat !< The augmented matrix used for the solution of the QD2T()s [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: AugMat_factor !< factored version of AugMat matrix [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: SolnVec !< b in the equation Ax=b (last column of AugMat) [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: AugMat_pivot !< Pivot column for AugMat in LAPACK factorization [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OgnlGeAzRo !< Original DOF_GeAz row in AugMat [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: QD2T !< Solution (acceleration) vector; the first time derivative of QDT [-] + LOGICAL :: IgnoreMod = .false. !< whether to ignore the modulo in ED outputs (necessary for linearization perturbations) [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OgnlYawRow !< Original DOF_Yaw row in AugMat [-] + REAL(ReKi) , DIMENSION(1:3) :: FrcONcRt = 0.0_ReKi !< Force acting on yaw bearing including inertial contributions [N] + REAL(ReKi) , DIMENSION(1:3) :: MomONcRt = 0.0_ReKi !< Moment acting on yaw bearing including inertial contributions [N-m] + REAL(ReKi) :: YawFriMz = 0.0_ReKi !< External loading on yaw bearing not including inertial contributions [N-m] + TYPE(ModJacType) :: Jac !< Values corresponding to module variables [-] + TYPE(ED_ContinuousStateType) :: x_perturb !< [-] + TYPE(ED_ContinuousStateType) :: dxdt_lin !< [-] + TYPE(ED_InputType) :: u_perturb !< [-] + TYPE(ED_OutputType) :: y_lin !< [-] + END TYPE ED_MiscVarType +! ======================= + integer(IntKi), public, parameter :: ED_x_QT = 1 ! ED%QT + integer(IntKi), public, parameter :: ED_x_QDT = 2 ! ED%QDT + integer(IntKi), public, parameter :: ED_z_DummyConstrState = 3 ! ED%DummyConstrState + integer(IntKi), public, parameter :: ED_u_BladePtLoads = 4 ! ED%BladePtLoads(DL%i1) + integer(IntKi), public, parameter :: ED_u_PlatformPtMesh = 5 ! ED%PlatformPtMesh + integer(IntKi), public, parameter :: ED_u_TowerPtLoads = 6 ! ED%TowerPtLoads + integer(IntKi), public, parameter :: ED_u_HubPtLoad = 7 ! ED%HubPtLoad + integer(IntKi), public, parameter :: ED_u_NacelleLoads = 8 ! ED%NacelleLoads + integer(IntKi), public, parameter :: ED_u_TFinCMLoads = 9 ! ED%TFinCMLoads + integer(IntKi), public, parameter :: ED_u_TwrAddedMass = 10 ! ED%TwrAddedMass + integer(IntKi), public, parameter :: ED_u_PtfmAddedMass = 11 ! ED%PtfmAddedMass + integer(IntKi), public, parameter :: ED_u_BlPitchCom = 12 ! ED%BlPitchCom + integer(IntKi), public, parameter :: ED_u_YawMom = 13 ! ED%YawMom + integer(IntKi), public, parameter :: ED_u_GenTrq = 14 ! ED%GenTrq + integer(IntKi), public, parameter :: ED_u_HSSBrTrqC = 15 ! ED%HSSBrTrqC + integer(IntKi), public, parameter :: ED_y_BladeLn2Mesh = 16 ! ED%BladeLn2Mesh(DL%i1) + integer(IntKi), public, parameter :: ED_y_PlatformPtMesh = 17 ! ED%PlatformPtMesh + integer(IntKi), public, parameter :: ED_y_TowerLn2Mesh = 18 ! ED%TowerLn2Mesh + integer(IntKi), public, parameter :: ED_y_HubPtMotion = 19 ! ED%HubPtMotion + integer(IntKi), public, parameter :: ED_y_BladeRootMotion = 20 ! ED%BladeRootMotion(DL%i1) + integer(IntKi), public, parameter :: ED_y_NacelleMotion = 21 ! ED%NacelleMotion + integer(IntKi), public, parameter :: ED_y_TFinCMMotion = 22 ! ED%TFinCMMotion + integer(IntKi), public, parameter :: ED_y_WriteOutput = 23 ! ED%WriteOutput + integer(IntKi), public, parameter :: ED_y_BlPitch = 24 ! ED%BlPitch + integer(IntKi), public, parameter :: ED_y_Yaw = 25 ! ED%Yaw + integer(IntKi), public, parameter :: ED_y_YawRate = 26 ! ED%YawRate + integer(IntKi), public, parameter :: ED_y_LSS_Spd = 27 ! ED%LSS_Spd + integer(IntKi), public, parameter :: ED_y_HSS_Spd = 28 ! ED%HSS_Spd + integer(IntKi), public, parameter :: ED_y_RotSpeed = 29 ! ED%RotSpeed + integer(IntKi), public, parameter :: ED_y_TwrAccel = 30 ! ED%TwrAccel + integer(IntKi), public, parameter :: ED_y_YawAngle = 31 ! ED%YawAngle + integer(IntKi), public, parameter :: ED_y_RootMyc = 32 ! ED%RootMyc + integer(IntKi), public, parameter :: ED_y_YawBrTAxp = 33 ! ED%YawBrTAxp + integer(IntKi), public, parameter :: ED_y_YawBrTAyp = 34 ! ED%YawBrTAyp + integer(IntKi), public, parameter :: ED_y_LSSTipPxa = 35 ! ED%LSSTipPxa + integer(IntKi), public, parameter :: ED_y_RootMxc = 36 ! ED%RootMxc + integer(IntKi), public, parameter :: ED_y_LSSTipMxa = 37 ! ED%LSSTipMxa + integer(IntKi), public, parameter :: ED_y_LSSTipMya = 38 ! ED%LSSTipMya + integer(IntKi), public, parameter :: ED_y_LSSTipMza = 39 ! ED%LSSTipMza + integer(IntKi), public, parameter :: ED_y_LSSTipMys = 40 ! ED%LSSTipMys + integer(IntKi), public, parameter :: ED_y_LSSTipMzs = 41 ! ED%LSSTipMzs + integer(IntKi), public, parameter :: ED_y_YawBrMyn = 42 ! ED%YawBrMyn + integer(IntKi), public, parameter :: ED_y_YawBrMzn = 43 ! ED%YawBrMzn + integer(IntKi), public, parameter :: ED_y_NcIMURAxs = 44 ! ED%NcIMURAxs + integer(IntKi), public, parameter :: ED_y_NcIMURAys = 45 ! ED%NcIMURAys + integer(IntKi), public, parameter :: ED_y_NcIMURAzs = 46 ! ED%NcIMURAzs + integer(IntKi), public, parameter :: ED_y_RotPwr = 47 ! ED%RotPwr + integer(IntKi), public, parameter :: ED_y_LSShftFxa = 48 ! ED%LSShftFxa + integer(IntKi), public, parameter :: ED_y_LSShftFys = 49 ! ED%LSShftFys + integer(IntKi), public, parameter :: ED_y_LSShftFzs = 50 ! ED%LSShftFzs + +contains subroutine ED_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(ED_InitInputType), intent(in) :: SrcInitInputData @@ -1135,6 +1169,9 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if DstInitOutputData%GearBox_index = SrcInitOutputData%GearBox_index + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine ED_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -1187,6 +1224,8 @@ subroutine ED_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%IsLoad_u)) then deallocate(InitOutputData%IsLoad_u) end if + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ED_PackInitOutput(RF, Indata) @@ -1222,6 +1261,7 @@ subroutine ED_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%RotFrame_u) call RegPackAlloc(RF, InData%IsLoad_u) call RegPack(RF, InData%GearBox_index) + call NWTC_Library_PackModVarsType(RF, InData%Vars) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1261,6 +1301,7 @@ subroutine ED_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%GearBox_index); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end subroutine subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg) @@ -4874,514 +4915,197 @@ subroutine ED_UnPackOtherState(RF, OutData) call RegUnpack(RF, OutData%OmegaDotTn); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(ED_MiscVarType), intent(in) :: SrcMiscData - type(ED_MiscVarType), intent(inout) :: DstMiscData +subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(ED_ParameterType), intent(in) :: SrcParamData + type(ED_ParameterType), intent(inout) :: DstParamData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2, i3, i4, i5 + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'ED_CopyMisc' + character(*), parameter :: RoutineName = 'ED_CopyParam' ErrStat = ErrID_None ErrMsg = '' - call ED_CopyCoordSys(SrcMiscData%CoordSys, DstMiscData%CoordSys, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call ED_CopyRtHndSide(SrcMiscData%RtHS, DstMiscData%RtHS, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts) - UB(1:1) = ubound(SrcMiscData%AllOuts) - if (.not. allocated(DstMiscData%AllOuts)) then - allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + DstParamData%DT = SrcParamData%DT + DstParamData%DT24 = SrcParamData%DT24 + DstParamData%BldNodes = SrcParamData%BldNodes + DstParamData%TipNode = SrcParamData%TipNode + DstParamData%NDOF = SrcParamData%NDOF + DstParamData%TwoPiNB = SrcParamData%TwoPiNB + DstParamData%NAug = SrcParamData%NAug + DstParamData%NPH = SrcParamData%NPH + if (allocated(SrcParamData%PH)) then + LB(1:1) = lbound(SrcParamData%PH) + UB(1:1) = ubound(SrcParamData%PH) + if (.not. allocated(DstParamData%PH)) then + allocate(DstParamData%PH(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PH.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%AllOuts = SrcMiscData%AllOuts + DstParamData%PH = SrcParamData%PH end if - if (allocated(SrcMiscData%AugMat)) then - LB(1:2) = lbound(SrcMiscData%AugMat) - UB(1:2) = ubound(SrcMiscData%AugMat) - if (.not. allocated(DstMiscData%AugMat)) then - allocate(DstMiscData%AugMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + DstParamData%NPM = SrcParamData%NPM + if (allocated(SrcParamData%PM)) then + LB(1:2) = lbound(SrcParamData%PM) + UB(1:2) = ubound(SrcParamData%PM) + if (.not. allocated(DstParamData%PM)) then + allocate(DstParamData%PM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PM.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%AugMat = SrcMiscData%AugMat + DstParamData%PM = SrcParamData%PM end if - if (allocated(SrcMiscData%AugMat_factor)) then - LB(1:2) = lbound(SrcMiscData%AugMat_factor) - UB(1:2) = ubound(SrcMiscData%AugMat_factor) - if (.not. allocated(DstMiscData%AugMat_factor)) then - allocate(DstMiscData%AugMat_factor(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%DOF_Flag)) then + LB(1:1) = lbound(SrcParamData%DOF_Flag) + UB(1:1) = ubound(SrcParamData%DOF_Flag) + if (.not. allocated(DstParamData%DOF_Flag)) then + allocate(DstParamData%DOF_Flag(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_factor.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOF_Flag.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%AugMat_factor = SrcMiscData%AugMat_factor + DstParamData%DOF_Flag = SrcParamData%DOF_Flag end if - if (allocated(SrcMiscData%SolnVec)) then - LB(1:1) = lbound(SrcMiscData%SolnVec) - UB(1:1) = ubound(SrcMiscData%SolnVec) - if (.not. allocated(DstMiscData%SolnVec)) then - allocate(DstMiscData%SolnVec(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%DOF_Desc)) then + LB(1:1) = lbound(SrcParamData%DOF_Desc) + UB(1:1) = ubound(SrcParamData%DOF_Desc) + if (.not. allocated(DstParamData%DOF_Desc)) then + allocate(DstParamData%DOF_Desc(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SolnVec.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOF_Desc.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%SolnVec = SrcMiscData%SolnVec + DstParamData%DOF_Desc = SrcParamData%DOF_Desc end if - if (allocated(SrcMiscData%AugMat_pivot)) then - LB(1:1) = lbound(SrcMiscData%AugMat_pivot) - UB(1:1) = ubound(SrcMiscData%AugMat_pivot) - if (.not. allocated(DstMiscData%AugMat_pivot)) then - allocate(DstMiscData%AugMat_pivot(LB(1):UB(1)), stat=ErrStat2) + call ED_CopyActiveDOFs(SrcParamData%DOFs, DstParamData%DOFs, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%NBlGages = SrcParamData%NBlGages + DstParamData%NTwGages = SrcParamData%NTwGages + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_pivot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%AugMat_pivot = SrcMiscData%AugMat_pivot + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcMiscData%OgnlGeAzRo)) then - LB(1:1) = lbound(SrcMiscData%OgnlGeAzRo) - UB(1:1) = ubound(SrcMiscData%OgnlGeAzRo) - if (.not. allocated(DstMiscData%OgnlGeAzRo)) then - allocate(DstMiscData%OgnlGeAzRo(LB(1):UB(1)), stat=ErrStat2) + DstParamData%Delim = SrcParamData%Delim + DstParamData%AvgNrmTpRd = SrcParamData%AvgNrmTpRd + DstParamData%AzimB1Up = SrcParamData%AzimB1Up + DstParamData%CosDel3 = SrcParamData%CosDel3 + if (allocated(SrcParamData%CosPreC)) then + LB(1:1) = lbound(SrcParamData%CosPreC) + UB(1:1) = ubound(SrcParamData%CosPreC) + if (.not. allocated(DstParamData%CosPreC)) then + allocate(DstParamData%CosPreC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%OgnlGeAzRo.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CosPreC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%OgnlGeAzRo = SrcMiscData%OgnlGeAzRo + DstParamData%CosPreC = SrcParamData%CosPreC end if - if (allocated(SrcMiscData%QD2T)) then - LB(1:1) = lbound(SrcMiscData%QD2T) - UB(1:1) = ubound(SrcMiscData%QD2T) - if (.not. allocated(DstMiscData%QD2T)) then - allocate(DstMiscData%QD2T(LB(1):UB(1)), stat=ErrStat2) + DstParamData%CRFrlSkew = SrcParamData%CRFrlSkew + DstParamData%CRFrlSkw2 = SrcParamData%CRFrlSkw2 + DstParamData%CRFrlTilt = SrcParamData%CRFrlTilt + DstParamData%CRFrlTlt2 = SrcParamData%CRFrlTlt2 + DstParamData%CShftSkew = SrcParamData%CShftSkew + DstParamData%CShftTilt = SrcParamData%CShftTilt + DstParamData%CSRFrlSkw = SrcParamData%CSRFrlSkw + DstParamData%CSRFrlTlt = SrcParamData%CSRFrlTlt + DstParamData%CSTFrlSkw = SrcParamData%CSTFrlSkw + DstParamData%CSTFrlTlt = SrcParamData%CSTFrlTlt + DstParamData%CTFrlSkew = SrcParamData%CTFrlSkew + DstParamData%CTFrlSkw2 = SrcParamData%CTFrlSkw2 + DstParamData%CTFrlTilt = SrcParamData%CTFrlTilt + DstParamData%CTFrlTlt2 = SrcParamData%CTFrlTlt2 + DstParamData%HubHt = SrcParamData%HubHt + DstParamData%HubCM = SrcParamData%HubCM + DstParamData%HubRad = SrcParamData%HubRad + DstParamData%NacCMxn = SrcParamData%NacCMxn + DstParamData%NacCMyn = SrcParamData%NacCMyn + DstParamData%NacCMzn = SrcParamData%NacCMzn + DstParamData%OverHang = SrcParamData%OverHang + DstParamData%ProjArea = SrcParamData%ProjArea + DstParamData%PtfmRefzt = SrcParamData%PtfmRefzt + DstParamData%RefTwrHt = SrcParamData%RefTwrHt + DstParamData%RFrlPnt_n = SrcParamData%RFrlPnt_n + DstParamData%rVDxn = SrcParamData%rVDxn + DstParamData%rVDyn = SrcParamData%rVDyn + DstParamData%rVDzn = SrcParamData%rVDzn + DstParamData%rVIMUxn = SrcParamData%rVIMUxn + DstParamData%rVIMUyn = SrcParamData%rVIMUyn + DstParamData%rVIMUzn = SrcParamData%rVIMUzn + DstParamData%rVPxn = SrcParamData%rVPxn + DstParamData%rVPyn = SrcParamData%rVPyn + DstParamData%rVPzn = SrcParamData%rVPzn + DstParamData%rWIxn = SrcParamData%rWIxn + DstParamData%rWIyn = SrcParamData%rWIyn + DstParamData%rWIzn = SrcParamData%rWIzn + DstParamData%rWJxn = SrcParamData%rWJxn + DstParamData%rWJyn = SrcParamData%rWJyn + DstParamData%rWJzn = SrcParamData%rWJzn + DstParamData%rZT0zt = SrcParamData%rZT0zt + DstParamData%rZYzt = SrcParamData%rZYzt + DstParamData%SinDel3 = SrcParamData%SinDel3 + if (allocated(SrcParamData%SinPreC)) then + LB(1:1) = lbound(SrcParamData%SinPreC) + UB(1:1) = ubound(SrcParamData%SinPreC) + if (.not. allocated(DstParamData%SinPreC)) then + allocate(DstParamData%SinPreC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%QD2T.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SinPreC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%QD2T = SrcMiscData%QD2T + DstParamData%SinPreC = SrcParamData%SinPreC end if - DstMiscData%IgnoreMod = SrcMiscData%IgnoreMod - if (allocated(SrcMiscData%OgnlYawRow)) then - LB(1:1) = lbound(SrcMiscData%OgnlYawRow) - UB(1:1) = ubound(SrcMiscData%OgnlYawRow) - if (.not. allocated(DstMiscData%OgnlYawRow)) then - allocate(DstMiscData%OgnlYawRow(LB(1):UB(1)), stat=ErrStat2) + DstParamData%SRFrlSkew = SrcParamData%SRFrlSkew + DstParamData%SRFrlSkw2 = SrcParamData%SRFrlSkw2 + DstParamData%SRFrlTilt = SrcParamData%SRFrlTilt + DstParamData%SRFrlTlt2 = SrcParamData%SRFrlTlt2 + DstParamData%SShftSkew = SrcParamData%SShftSkew + DstParamData%SShftTilt = SrcParamData%SShftTilt + DstParamData%STFrlSkew = SrcParamData%STFrlSkew + DstParamData%STFrlSkw2 = SrcParamData%STFrlSkw2 + DstParamData%STFrlTilt = SrcParamData%STFrlTilt + DstParamData%STFrlTlt2 = SrcParamData%STFrlTlt2 + DstParamData%TFrlPnt_n = SrcParamData%TFrlPnt_n + DstParamData%TipRad = SrcParamData%TipRad + DstParamData%TowerHt = SrcParamData%TowerHt + DstParamData%TowerBsHt = SrcParamData%TowerBsHt + DstParamData%UndSling = SrcParamData%UndSling + DstParamData%NumBl = SrcParamData%NumBl + if (allocated(SrcParamData%AxRedTFA)) then + LB(1:3) = lbound(SrcParamData%AxRedTFA) + UB(1:3) = ubound(SrcParamData%AxRedTFA) + if (.not. allocated(DstParamData%AxRedTFA)) then + allocate(DstParamData%AxRedTFA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%OgnlYawRow.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedTFA.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%OgnlYawRow = SrcMiscData%OgnlYawRow - end if - DstMiscData%FrcONcRt = SrcMiscData%FrcONcRt - DstMiscData%MomONcRt = SrcMiscData%MomONcRt - DstMiscData%YawFriMz = SrcMiscData%YawFriMz -end subroutine - -subroutine ED_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(ED_MiscVarType), intent(inout) :: MiscData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'ED_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = '' - call ED_DestroyCoordSys(MiscData%CoordSys, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ED_DestroyRtHndSide(MiscData%RtHS, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(MiscData%AllOuts)) then - deallocate(MiscData%AllOuts) - end if - if (allocated(MiscData%AugMat)) then - deallocate(MiscData%AugMat) - end if - if (allocated(MiscData%AugMat_factor)) then - deallocate(MiscData%AugMat_factor) - end if - if (allocated(MiscData%SolnVec)) then - deallocate(MiscData%SolnVec) - end if - if (allocated(MiscData%AugMat_pivot)) then - deallocate(MiscData%AugMat_pivot) - end if - if (allocated(MiscData%OgnlGeAzRo)) then - deallocate(MiscData%OgnlGeAzRo) - end if - if (allocated(MiscData%QD2T)) then - deallocate(MiscData%QD2T) - end if - if (allocated(MiscData%OgnlYawRow)) then - deallocate(MiscData%OgnlYawRow) - end if -end subroutine - -subroutine ED_PackMisc(RF, Indata) - type(RegFile), intent(inout) :: RF - type(ED_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'ED_PackMisc' - if (RF%ErrStat >= AbortErrLev) return - call ED_PackCoordSys(RF, InData%CoordSys) - call ED_PackRtHndSide(RF, InData%RtHS) - call RegPackAlloc(RF, InData%AllOuts) - call RegPackAlloc(RF, InData%AugMat) - call RegPackAlloc(RF, InData%AugMat_factor) - call RegPackAlloc(RF, InData%SolnVec) - call RegPackAlloc(RF, InData%AugMat_pivot) - call RegPackAlloc(RF, InData%OgnlGeAzRo) - call RegPackAlloc(RF, InData%QD2T) - call RegPack(RF, InData%IgnoreMod) - call RegPackAlloc(RF, InData%OgnlYawRow) - call RegPack(RF, InData%FrcONcRt) - call RegPack(RF, InData%MomONcRt) - call RegPack(RF, InData%YawFriMz) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine ED_UnPackMisc(RF, OutData) - type(RegFile), intent(inout) :: RF - type(ED_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'ED_UnPackMisc' - integer(B4Ki) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call ED_UnpackCoordSys(RF, OutData%CoordSys) ! CoordSys - call ED_UnpackRtHndSide(RF, OutData%RtHS) ! RtHS - call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%AugMat); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%AugMat_factor); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%SolnVec); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%AugMat_pivot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%OgnlGeAzRo); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%QD2T); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%IgnoreMod); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%OgnlYawRow); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%FrcONcRt); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%MomONcRt); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawFriMz); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine ED_CopyJac_u_idxStarts(SrcJac_u_idxStartsData, DstJac_u_idxStartsData, CtrlCode, ErrStat, ErrMsg) - type(Jac_u_idxStarts), intent(in) :: SrcJac_u_idxStartsData - type(Jac_u_idxStarts), intent(inout) :: DstJac_u_idxStartsData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'ED_CopyJac_u_idxStarts' - ErrStat = ErrID_None - ErrMsg = '' - DstJac_u_idxStartsData%BladeLoad = SrcJac_u_idxStartsData%BladeLoad - DstJac_u_idxStartsData%PlatformLoad = SrcJac_u_idxStartsData%PlatformLoad - DstJac_u_idxStartsData%TowerLoad = SrcJac_u_idxStartsData%TowerLoad - DstJac_u_idxStartsData%HubLoad = SrcJac_u_idxStartsData%HubLoad - DstJac_u_idxStartsData%NacelleLoad = SrcJac_u_idxStartsData%NacelleLoad - DstJac_u_idxStartsData%TFinLoad = SrcJac_u_idxStartsData%TFinLoad - DstJac_u_idxStartsData%BlPitchCom = SrcJac_u_idxStartsData%BlPitchCom -end subroutine - -subroutine ED_DestroyJac_u_idxStarts(Jac_u_idxStartsData, ErrStat, ErrMsg) - type(Jac_u_idxStarts), intent(inout) :: Jac_u_idxStartsData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'ED_DestroyJac_u_idxStarts' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine ED_PackJac_u_idxStarts(RF, Indata) - type(RegFile), intent(inout) :: RF - type(Jac_u_idxStarts), intent(in) :: InData - character(*), parameter :: RoutineName = 'ED_PackJac_u_idxStarts' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%BladeLoad) - call RegPack(RF, InData%PlatformLoad) - call RegPack(RF, InData%TowerLoad) - call RegPack(RF, InData%HubLoad) - call RegPack(RF, InData%NacelleLoad) - call RegPack(RF, InData%TFinLoad) - call RegPack(RF, InData%BlPitchCom) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine ED_UnPackJac_u_idxStarts(RF, OutData) - type(RegFile), intent(inout) :: RF - type(Jac_u_idxStarts), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'ED_UnPackJac_u_idxStarts' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%BladeLoad); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%PlatformLoad); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TowerLoad); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%HubLoad); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NacelleLoad); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFinLoad); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%BlPitchCom); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine ED_CopyJac_y_idxStarts(SrcJac_y_idxStartsData, DstJac_y_idxStartsData, CtrlCode, ErrStat, ErrMsg) - type(Jac_y_idxStarts), intent(in) :: SrcJac_y_idxStartsData - type(Jac_y_idxStarts), intent(inout) :: DstJac_y_idxStartsData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'ED_CopyJac_y_idxStarts' - ErrStat = ErrID_None - ErrMsg = '' - DstJac_y_idxStartsData%Blade = SrcJac_y_idxStartsData%Blade - DstJac_y_idxStartsData%Platform = SrcJac_y_idxStartsData%Platform - DstJac_y_idxStartsData%Tower = SrcJac_y_idxStartsData%Tower - DstJac_y_idxStartsData%Hub = SrcJac_y_idxStartsData%Hub - DstJac_y_idxStartsData%BladeRoot = SrcJac_y_idxStartsData%BladeRoot - DstJac_y_idxStartsData%Nacelle = SrcJac_y_idxStartsData%Nacelle - DstJac_y_idxStartsData%TFin = SrcJac_y_idxStartsData%TFin -end subroutine - -subroutine ED_DestroyJac_y_idxStarts(Jac_y_idxStartsData, ErrStat, ErrMsg) - type(Jac_y_idxStarts), intent(inout) :: Jac_y_idxStartsData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'ED_DestroyJac_y_idxStarts' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine ED_PackJac_y_idxStarts(RF, Indata) - type(RegFile), intent(inout) :: RF - type(Jac_y_idxStarts), intent(in) :: InData - character(*), parameter :: RoutineName = 'ED_PackJac_y_idxStarts' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%Blade) - call RegPack(RF, InData%Platform) - call RegPack(RF, InData%Tower) - call RegPack(RF, InData%Hub) - call RegPack(RF, InData%BladeRoot) - call RegPack(RF, InData%Nacelle) - call RegPack(RF, InData%TFin) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine ED_UnPackJac_y_idxStarts(RF, OutData) - type(RegFile), intent(inout) :: RF - type(Jac_y_idxStarts), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'ED_UnPackJac_y_idxStarts' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%Blade); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Platform); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Tower); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Hub); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%BladeRoot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nacelle); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TFin); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) - type(ED_ParameterType), intent(in) :: SrcParamData - type(ED_ParameterType), intent(inout) :: DstParamData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2, i3, i4, i5 - integer(B4Ki) :: LB(5), UB(5) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'ED_CopyParam' - ErrStat = ErrID_None - ErrMsg = '' - DstParamData%DT = SrcParamData%DT - DstParamData%DT24 = SrcParamData%DT24 - DstParamData%BldNodes = SrcParamData%BldNodes - DstParamData%TipNode = SrcParamData%TipNode - DstParamData%NDOF = SrcParamData%NDOF - DstParamData%TwoPiNB = SrcParamData%TwoPiNB - DstParamData%NAug = SrcParamData%NAug - DstParamData%NPH = SrcParamData%NPH - if (allocated(SrcParamData%PH)) then - LB(1:1) = lbound(SrcParamData%PH) - UB(1:1) = ubound(SrcParamData%PH) - if (.not. allocated(DstParamData%PH)) then - allocate(DstParamData%PH(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PH.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%PH = SrcParamData%PH - end if - DstParamData%NPM = SrcParamData%NPM - if (allocated(SrcParamData%PM)) then - LB(1:2) = lbound(SrcParamData%PM) - UB(1:2) = ubound(SrcParamData%PM) - if (.not. allocated(DstParamData%PM)) then - allocate(DstParamData%PM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PM.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%PM = SrcParamData%PM - end if - if (allocated(SrcParamData%DOF_Flag)) then - LB(1:1) = lbound(SrcParamData%DOF_Flag) - UB(1:1) = ubound(SrcParamData%DOF_Flag) - if (.not. allocated(DstParamData%DOF_Flag)) then - allocate(DstParamData%DOF_Flag(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOF_Flag.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%DOF_Flag = SrcParamData%DOF_Flag - end if - if (allocated(SrcParamData%DOF_Desc)) then - LB(1:1) = lbound(SrcParamData%DOF_Desc) - UB(1:1) = ubound(SrcParamData%DOF_Desc) - if (.not. allocated(DstParamData%DOF_Desc)) then - allocate(DstParamData%DOF_Desc(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOF_Desc.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%DOF_Desc = SrcParamData%DOF_Desc - end if - call ED_CopyActiveDOFs(SrcParamData%DOFs, DstParamData%DOFs, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%NBlGages = SrcParamData%NBlGages - DstParamData%NTwGages = SrcParamData%NTwGages - if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam) - UB(1:1) = ubound(SrcParamData%OutParam) - if (.not. allocated(DstParamData%OutParam)) then - allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - DstParamData%Delim = SrcParamData%Delim - DstParamData%AvgNrmTpRd = SrcParamData%AvgNrmTpRd - DstParamData%AzimB1Up = SrcParamData%AzimB1Up - DstParamData%CosDel3 = SrcParamData%CosDel3 - if (allocated(SrcParamData%CosPreC)) then - LB(1:1) = lbound(SrcParamData%CosPreC) - UB(1:1) = ubound(SrcParamData%CosPreC) - if (.not. allocated(DstParamData%CosPreC)) then - allocate(DstParamData%CosPreC(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CosPreC.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%CosPreC = SrcParamData%CosPreC - end if - DstParamData%CRFrlSkew = SrcParamData%CRFrlSkew - DstParamData%CRFrlSkw2 = SrcParamData%CRFrlSkw2 - DstParamData%CRFrlTilt = SrcParamData%CRFrlTilt - DstParamData%CRFrlTlt2 = SrcParamData%CRFrlTlt2 - DstParamData%CShftSkew = SrcParamData%CShftSkew - DstParamData%CShftTilt = SrcParamData%CShftTilt - DstParamData%CSRFrlSkw = SrcParamData%CSRFrlSkw - DstParamData%CSRFrlTlt = SrcParamData%CSRFrlTlt - DstParamData%CSTFrlSkw = SrcParamData%CSTFrlSkw - DstParamData%CSTFrlTlt = SrcParamData%CSTFrlTlt - DstParamData%CTFrlSkew = SrcParamData%CTFrlSkew - DstParamData%CTFrlSkw2 = SrcParamData%CTFrlSkw2 - DstParamData%CTFrlTilt = SrcParamData%CTFrlTilt - DstParamData%CTFrlTlt2 = SrcParamData%CTFrlTlt2 - DstParamData%HubHt = SrcParamData%HubHt - DstParamData%HubCM = SrcParamData%HubCM - DstParamData%HubRad = SrcParamData%HubRad - DstParamData%NacCMxn = SrcParamData%NacCMxn - DstParamData%NacCMyn = SrcParamData%NacCMyn - DstParamData%NacCMzn = SrcParamData%NacCMzn - DstParamData%OverHang = SrcParamData%OverHang - DstParamData%ProjArea = SrcParamData%ProjArea - DstParamData%PtfmRefzt = SrcParamData%PtfmRefzt - DstParamData%RefTwrHt = SrcParamData%RefTwrHt - DstParamData%RFrlPnt_n = SrcParamData%RFrlPnt_n - DstParamData%rVDxn = SrcParamData%rVDxn - DstParamData%rVDyn = SrcParamData%rVDyn - DstParamData%rVDzn = SrcParamData%rVDzn - DstParamData%rVIMUxn = SrcParamData%rVIMUxn - DstParamData%rVIMUyn = SrcParamData%rVIMUyn - DstParamData%rVIMUzn = SrcParamData%rVIMUzn - DstParamData%rVPxn = SrcParamData%rVPxn - DstParamData%rVPyn = SrcParamData%rVPyn - DstParamData%rVPzn = SrcParamData%rVPzn - DstParamData%rWIxn = SrcParamData%rWIxn - DstParamData%rWIyn = SrcParamData%rWIyn - DstParamData%rWIzn = SrcParamData%rWIzn - DstParamData%rWJxn = SrcParamData%rWJxn - DstParamData%rWJyn = SrcParamData%rWJyn - DstParamData%rWJzn = SrcParamData%rWJzn - DstParamData%rZT0zt = SrcParamData%rZT0zt - DstParamData%rZYzt = SrcParamData%rZYzt - DstParamData%SinDel3 = SrcParamData%SinDel3 - if (allocated(SrcParamData%SinPreC)) then - LB(1:1) = lbound(SrcParamData%SinPreC) - UB(1:1) = ubound(SrcParamData%SinPreC) - if (.not. allocated(DstParamData%SinPreC)) then - allocate(DstParamData%SinPreC(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SinPreC.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%SinPreC = SrcParamData%SinPreC - end if - DstParamData%SRFrlSkew = SrcParamData%SRFrlSkew - DstParamData%SRFrlSkw2 = SrcParamData%SRFrlSkw2 - DstParamData%SRFrlTilt = SrcParamData%SRFrlTilt - DstParamData%SRFrlTlt2 = SrcParamData%SRFrlTlt2 - DstParamData%SShftSkew = SrcParamData%SShftSkew - DstParamData%SShftTilt = SrcParamData%SShftTilt - DstParamData%STFrlSkew = SrcParamData%STFrlSkew - DstParamData%STFrlSkw2 = SrcParamData%STFrlSkw2 - DstParamData%STFrlTilt = SrcParamData%STFrlTilt - DstParamData%STFrlTlt2 = SrcParamData%STFrlTlt2 - DstParamData%TFrlPnt_n = SrcParamData%TFrlPnt_n - DstParamData%TipRad = SrcParamData%TipRad - DstParamData%TowerHt = SrcParamData%TowerHt - DstParamData%TowerBsHt = SrcParamData%TowerBsHt - DstParamData%UndSling = SrcParamData%UndSling - DstParamData%NumBl = SrcParamData%NumBl - if (allocated(SrcParamData%AxRedTFA)) then - LB(1:3) = lbound(SrcParamData%AxRedTFA) - UB(1:3) = ubound(SrcParamData%AxRedTFA) - if (.not. allocated(DstParamData%AxRedTFA)) then - allocate(DstParamData%AxRedTFA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedTFA.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%AxRedTFA = SrcParamData%AxRedTFA + DstParamData%AxRedTFA = SrcParamData%AxRedTFA end if if (allocated(SrcParamData%AxRedTSS)) then LB(1:3) = lbound(SrcParamData%AxRedTSS) @@ -6046,12 +5770,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if DstParamData%BldNd_BladesOut = SrcParamData%BldNd_BladesOut - call ED_CopyJac_u_idxStarts(SrcParamData%Jac_u_idxStartList, DstParamData%Jac_u_idxStartList, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call ED_CopyJac_y_idxStarts(SrcParamData%Jac_y_idxStartList, DstParamData%Jac_y_idxStartList, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return if (allocated(SrcParamData%Jac_u_indx)) then LB(1:2) = lbound(SrcParamData%Jac_u_indx) UB(1:2) = ubound(SrcParamData%Jac_u_indx) @@ -6287,10 +6005,6 @@ subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) end do deallocate(ParamData%BldNd_OutParam) end if - call ED_DestroyJac_u_idxStarts(ParamData%Jac_u_idxStartList, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ED_DestroyJac_y_idxStarts(ParamData%Jac_y_idxStartList, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%Jac_u_indx)) then deallocate(ParamData%Jac_u_indx) end if @@ -6552,8 +6266,6 @@ subroutine ED_PackParam(RF, Indata) end do end if call RegPack(RF, InData%BldNd_BladesOut) - call ED_PackJac_u_idxStarts(RF, InData%Jac_u_idxStartList) - call ED_PackJac_y_idxStarts(RF, InData%Jac_y_idxStartList) call RegPackAlloc(RF, InData%Jac_u_indx) call RegPackAlloc(RF, InData%du) call RegPackAlloc(RF, InData%dx) @@ -6827,8 +6539,6 @@ subroutine ED_UnPackParam(RF, OutData) end do end if call RegUnpack(RF, OutData%BldNd_BladesOut); if (RegCheckErr(RF, RoutineName)) return - call ED_UnpackJac_u_idxStarts(RF, OutData%Jac_u_idxStartList) ! Jac_u_idxStartList - call ED_UnpackJac_y_idxStarts(RF, OutData%Jac_y_idxStartList) ! Jac_y_idxStartList call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return @@ -6847,465 +6557,705 @@ subroutine ED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2, i3 - integer(B4Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%BladePtLoads)) then + LB(1:1) = lbound(SrcInputData%BladePtLoads) + UB(1:1) = ubound(SrcInputData%BladePtLoads) + if (.not. allocated(DstInputData%BladePtLoads)) then + allocate(DstInputData%BladePtLoads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BladePtLoads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%BladePtLoads(i1), DstInputData%BladePtLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcInputData%PlatformPtMesh, DstInputData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%TowerPtLoads, DstInputData%TowerPtLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%HubPtLoad, DstInputData%HubPtLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%NacelleLoads, DstInputData%NacelleLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%TFinCMLoads, DstInputData%TFinCMLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInputData%TwrAddedMass)) then + LB(1:3) = lbound(SrcInputData%TwrAddedMass) + UB(1:3) = ubound(SrcInputData%TwrAddedMass) + if (.not. allocated(DstInputData%TwrAddedMass)) then + allocate(DstInputData%TwrAddedMass(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%TwrAddedMass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%TwrAddedMass = SrcInputData%TwrAddedMass + end if + DstInputData%PtfmAddedMass = SrcInputData%PtfmAddedMass + if (allocated(SrcInputData%BlPitchCom)) then + LB(1:1) = lbound(SrcInputData%BlPitchCom) + UB(1:1) = ubound(SrcInputData%BlPitchCom) + if (.not. allocated(DstInputData%BlPitchCom)) then + allocate(DstInputData%BlPitchCom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BlPitchCom.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%BlPitchCom = SrcInputData%BlPitchCom + end if + DstInputData%YawMom = SrcInputData%YawMom + DstInputData%GenTrq = SrcInputData%GenTrq + DstInputData%HSSBrTrqC = SrcInputData%HSSBrTrqC +end subroutine + +subroutine ED_DestroyInput(InputData, ErrStat, ErrMsg) + type(ED_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%BladePtLoads)) then + LB(1:1) = lbound(InputData%BladePtLoads) + UB(1:1) = ubound(InputData%BladePtLoads) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%BladePtLoads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%BladePtLoads) + end if + call MeshDestroy( InputData%PlatformPtMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%TowerPtLoads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%HubPtLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%NacelleLoads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%TFinCMLoads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InputData%TwrAddedMass)) then + deallocate(InputData%TwrAddedMass) + end if + if (allocated(InputData%BlPitchCom)) then + deallocate(InputData%BlPitchCom) + end if +end subroutine + +subroutine ED_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ED_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackInput' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%BladePtLoads)) + if (allocated(InData%BladePtLoads)) then + call RegPackBounds(RF, 1, lbound(InData%BladePtLoads), ubound(InData%BladePtLoads)) + LB(1:1) = lbound(InData%BladePtLoads) + UB(1:1) = ubound(InData%BladePtLoads) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladePtLoads(i1)) + end do + end if + call MeshPack(RF, InData%PlatformPtMesh) + call MeshPack(RF, InData%TowerPtLoads) + call MeshPack(RF, InData%HubPtLoad) + call MeshPack(RF, InData%NacelleLoads) + call MeshPack(RF, InData%TFinCMLoads) + call RegPackAlloc(RF, InData%TwrAddedMass) + call RegPack(RF, InData%PtfmAddedMass) + call RegPackAlloc(RF, InData%BlPitchCom) + call RegPack(RF, InData%YawMom) + call RegPack(RF, InData%GenTrq) + call RegPack(RF, InData%HSSBrTrqC) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ED_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackInput' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%BladePtLoads)) deallocate(OutData%BladePtLoads) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladePtLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladePtLoads.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladePtLoads(i1)) ! BladePtLoads + end do + end if + call MeshUnpack(RF, OutData%PlatformPtMesh) ! PlatformPtMesh + call MeshUnpack(RF, OutData%TowerPtLoads) ! TowerPtLoads + call MeshUnpack(RF, OutData%HubPtLoad) ! HubPtLoad + call MeshUnpack(RF, OutData%NacelleLoads) ! NacelleLoads + call MeshUnpack(RF, OutData%TFinCMLoads) ! TFinCMLoads + call RegUnpackAlloc(RF, OutData%TwrAddedMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmAddedMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitchCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawMom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrTrqC); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(ED_OutputType), intent(inout) :: SrcOutputData + type(ED_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'ED_CopyInput' + character(*), parameter :: RoutineName = 'ED_CopyOutput' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcInputData%BladePtLoads)) then - LB(1:1) = lbound(SrcInputData%BladePtLoads) - UB(1:1) = ubound(SrcInputData%BladePtLoads) - if (.not. allocated(DstInputData%BladePtLoads)) then - allocate(DstInputData%BladePtLoads(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%BladeLn2Mesh)) then + LB(1:1) = lbound(SrcOutputData%BladeLn2Mesh) + UB(1:1) = ubound(SrcOutputData%BladeLn2Mesh) + if (.not. allocated(DstOutputData%BladeLn2Mesh)) then + allocate(DstOutputData%BladeLn2Mesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BladePtLoads.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeLn2Mesh.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MeshCopy(SrcInputData%BladePtLoads(i1), DstInputData%BladePtLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call MeshCopy(SrcOutputData%BladeLn2Mesh(i1), DstOutputData%BladeLn2Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - call MeshCopy(SrcInputData%PlatformPtMesh, DstInputData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call MeshCopy(SrcOutputData%PlatformPtMesh, DstOutputData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcInputData%TowerPtLoads, DstInputData%TowerPtLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call MeshCopy(SrcOutputData%TowerLn2Mesh, DstOutputData%TowerLn2Mesh, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcInputData%HubPtLoad, DstInputData%HubPtLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call MeshCopy(SrcOutputData%HubPtMotion, DstOutputData%HubPtMotion, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcInputData%NacelleLoads, DstInputData%NacelleLoads, CtrlCode, ErrStat2, ErrMsg2 ) + if (allocated(SrcOutputData%BladeRootMotion)) then + LB(1:1) = lbound(SrcOutputData%BladeRootMotion) + UB(1:1) = ubound(SrcOutputData%BladeRootMotion) + if (.not. allocated(DstOutputData%BladeRootMotion)) then + allocate(DstOutputData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeRootMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%BladeRootMotion(i1), DstOutputData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcOutputData%NacelleMotion, DstOutputData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcInputData%TFinCMLoads, DstInputData%TFinCMLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call MeshCopy(SrcOutputData%TFinCMMotion, DstOutputData%TFinCMMotion, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - if (allocated(SrcInputData%TwrAddedMass)) then - LB(1:3) = lbound(SrcInputData%TwrAddedMass) - UB(1:3) = ubound(SrcInputData%TwrAddedMass) - if (.not. allocated(DstInputData%TwrAddedMass)) then - allocate(DstInputData%TwrAddedMass(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%TwrAddedMass.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputData%TwrAddedMass = SrcInputData%TwrAddedMass + DstOutputData%WriteOutput = SrcOutputData%WriteOutput end if - DstInputData%PtfmAddedMass = SrcInputData%PtfmAddedMass - if (allocated(SrcInputData%BlPitchCom)) then - LB(1:1) = lbound(SrcInputData%BlPitchCom) - UB(1:1) = ubound(SrcInputData%BlPitchCom) - if (.not. allocated(DstInputData%BlPitchCom)) then - allocate(DstInputData%BlPitchCom(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%BlPitch)) then + LB(1:1) = lbound(SrcOutputData%BlPitch) + UB(1:1) = ubound(SrcOutputData%BlPitch) + if (.not. allocated(DstOutputData%BlPitch)) then + allocate(DstOutputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BlPitchCom.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlPitch.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputData%BlPitchCom = SrcInputData%BlPitchCom + DstOutputData%BlPitch = SrcOutputData%BlPitch end if - DstInputData%YawMom = SrcInputData%YawMom - DstInputData%GenTrq = SrcInputData%GenTrq - DstInputData%HSSBrTrqC = SrcInputData%HSSBrTrqC + DstOutputData%Yaw = SrcOutputData%Yaw + DstOutputData%YawRate = SrcOutputData%YawRate + DstOutputData%LSS_Spd = SrcOutputData%LSS_Spd + DstOutputData%HSS_Spd = SrcOutputData%HSS_Spd + DstOutputData%RotSpeed = SrcOutputData%RotSpeed + DstOutputData%TwrAccel = SrcOutputData%TwrAccel + DstOutputData%YawAngle = SrcOutputData%YawAngle + DstOutputData%RootMyc = SrcOutputData%RootMyc + DstOutputData%YawBrTAxp = SrcOutputData%YawBrTAxp + DstOutputData%YawBrTAyp = SrcOutputData%YawBrTAyp + DstOutputData%LSSTipPxa = SrcOutputData%LSSTipPxa + DstOutputData%RootMxc = SrcOutputData%RootMxc + DstOutputData%LSSTipMxa = SrcOutputData%LSSTipMxa + DstOutputData%LSSTipMya = SrcOutputData%LSSTipMya + DstOutputData%LSSTipMza = SrcOutputData%LSSTipMza + DstOutputData%LSSTipMys = SrcOutputData%LSSTipMys + DstOutputData%LSSTipMzs = SrcOutputData%LSSTipMzs + DstOutputData%YawBrMyn = SrcOutputData%YawBrMyn + DstOutputData%YawBrMzn = SrcOutputData%YawBrMzn + DstOutputData%NcIMURAxs = SrcOutputData%NcIMURAxs + DstOutputData%NcIMURAys = SrcOutputData%NcIMURAys + DstOutputData%NcIMURAzs = SrcOutputData%NcIMURAzs + DstOutputData%RotPwr = SrcOutputData%RotPwr + DstOutputData%LSShftFxa = SrcOutputData%LSShftFxa + DstOutputData%LSShftFys = SrcOutputData%LSShftFys + DstOutputData%LSShftFzs = SrcOutputData%LSShftFzs end subroutine -subroutine ED_DestroyInput(InputData, ErrStat, ErrMsg) - type(ED_InputType), intent(inout) :: InputData +subroutine ED_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(ED_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2, i3 - integer(B4Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'ED_DestroyInput' + character(*), parameter :: RoutineName = 'ED_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' - if (allocated(InputData%BladePtLoads)) then - LB(1:1) = lbound(InputData%BladePtLoads) - UB(1:1) = ubound(InputData%BladePtLoads) + if (allocated(OutputData%BladeLn2Mesh)) then + LB(1:1) = lbound(OutputData%BladeLn2Mesh) + UB(1:1) = ubound(OutputData%BladeLn2Mesh) do i1 = LB(1), UB(1) - call MeshDestroy( InputData%BladePtLoads(i1), ErrStat2, ErrMsg2) + call MeshDestroy( OutputData%BladeLn2Mesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(InputData%BladePtLoads) + deallocate(OutputData%BladeLn2Mesh) end if - call MeshDestroy( InputData%PlatformPtMesh, ErrStat2, ErrMsg2) + call MeshDestroy( OutputData%PlatformPtMesh, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( InputData%TowerPtLoads, ErrStat2, ErrMsg2) + call MeshDestroy( OutputData%TowerLn2Mesh, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( InputData%HubPtLoad, ErrStat2, ErrMsg2) + call MeshDestroy( OutputData%HubPtMotion, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( InputData%NacelleLoads, ErrStat2, ErrMsg2) + if (allocated(OutputData%BladeRootMotion)) then + LB(1:1) = lbound(OutputData%BladeRootMotion) + UB(1:1) = ubound(OutputData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%BladeRootMotion(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%BladeRootMotion) + end if + call MeshDestroy( OutputData%NacelleMotion, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( InputData%TFinCMLoads, ErrStat2, ErrMsg2) + call MeshDestroy( OutputData%TFinCMMotion, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(InputData%TwrAddedMass)) then - deallocate(InputData%TwrAddedMass) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) end if - if (allocated(InputData%BlPitchCom)) then - deallocate(InputData%BlPitchCom) + if (allocated(OutputData%BlPitch)) then + deallocate(OutputData%BlPitch) end if end subroutine -subroutine ED_PackInput(RF, Indata) +subroutine ED_PackOutput(RF, Indata) type(RegFile), intent(inout) :: RF - type(ED_InputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'ED_PackInput' - integer(B4Ki) :: i1, i2, i3 - integer(B4Ki) :: LB(3), UB(3) + type(ED_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%BladePtLoads)) - if (allocated(InData%BladePtLoads)) then - call RegPackBounds(RF, 1, lbound(InData%BladePtLoads), ubound(InData%BladePtLoads)) - LB(1:1) = lbound(InData%BladePtLoads) - UB(1:1) = ubound(InData%BladePtLoads) + call RegPack(RF, allocated(InData%BladeLn2Mesh)) + if (allocated(InData%BladeLn2Mesh)) then + call RegPackBounds(RF, 1, lbound(InData%BladeLn2Mesh), ubound(InData%BladeLn2Mesh)) + LB(1:1) = lbound(InData%BladeLn2Mesh) + UB(1:1) = ubound(InData%BladeLn2Mesh) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%BladePtLoads(i1)) + call MeshPack(RF, InData%BladeLn2Mesh(i1)) end do end if call MeshPack(RF, InData%PlatformPtMesh) - call MeshPack(RF, InData%TowerPtLoads) - call MeshPack(RF, InData%HubPtLoad) - call MeshPack(RF, InData%NacelleLoads) - call MeshPack(RF, InData%TFinCMLoads) - call RegPackAlloc(RF, InData%TwrAddedMass) - call RegPack(RF, InData%PtfmAddedMass) - call RegPackAlloc(RF, InData%BlPitchCom) - call RegPack(RF, InData%YawMom) - call RegPack(RF, InData%GenTrq) - call RegPack(RF, InData%HSSBrTrqC) + call MeshPack(RF, InData%TowerLn2Mesh) + call MeshPack(RF, InData%HubPtMotion) + call RegPack(RF, allocated(InData%BladeRootMotion)) + if (allocated(InData%BladeRootMotion)) then + call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) + LB(1:1) = lbound(InData%BladeRootMotion) + UB(1:1) = ubound(InData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeRootMotion(i1)) + end do + end if + call MeshPack(RF, InData%NacelleMotion) + call MeshPack(RF, InData%TFinCMMotion) + call RegPackAlloc(RF, InData%WriteOutput) + call RegPackAlloc(RF, InData%BlPitch) + call RegPack(RF, InData%Yaw) + call RegPack(RF, InData%YawRate) + call RegPack(RF, InData%LSS_Spd) + call RegPack(RF, InData%HSS_Spd) + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%TwrAccel) + call RegPack(RF, InData%YawAngle) + call RegPack(RF, InData%RootMyc) + call RegPack(RF, InData%YawBrTAxp) + call RegPack(RF, InData%YawBrTAyp) + call RegPack(RF, InData%LSSTipPxa) + call RegPack(RF, InData%RootMxc) + call RegPack(RF, InData%LSSTipMxa) + call RegPack(RF, InData%LSSTipMya) + call RegPack(RF, InData%LSSTipMza) + call RegPack(RF, InData%LSSTipMys) + call RegPack(RF, InData%LSSTipMzs) + call RegPack(RF, InData%YawBrMyn) + call RegPack(RF, InData%YawBrMzn) + call RegPack(RF, InData%NcIMURAxs) + call RegPack(RF, InData%NcIMURAys) + call RegPack(RF, InData%NcIMURAzs) + call RegPack(RF, InData%RotPwr) + call RegPack(RF, InData%LSShftFxa) + call RegPack(RF, InData%LSShftFys) + call RegPack(RF, InData%LSShftFzs) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ED_UnPackInput(RF, OutData) +subroutine ED_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF - type(ED_InputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'ED_UnPackInput' - integer(B4Ki) :: i1, i2, i3 - integer(B4Ki) :: LB(3), UB(3) + type(ED_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%BladePtLoads)) deallocate(OutData%BladePtLoads) + if (allocated(OutData%BladeLn2Mesh)) deallocate(OutData%BladeLn2Mesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeLn2Mesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLn2Mesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladeLn2Mesh(i1)) ! BladeLn2Mesh + end do + end if + call MeshUnpack(RF, OutData%PlatformPtMesh) ! PlatformPtMesh + call MeshUnpack(RF, OutData%TowerLn2Mesh) ! TowerLn2Mesh + call MeshUnpack(RF, OutData%HubPtMotion) ! HubPtMotion + if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BladePtLoads(LB(1):UB(1)),stat=stat) + allocate(OutData%BladeRootMotion(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladePtLoads.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%BladePtLoads(i1)) ! BladePtLoads + call MeshUnpack(RF, OutData%BladeRootMotion(i1)) ! BladeRootMotion end do end if - call MeshUnpack(RF, OutData%PlatformPtMesh) ! PlatformPtMesh - call MeshUnpack(RF, OutData%TowerPtLoads) ! TowerPtLoads - call MeshUnpack(RF, OutData%HubPtLoad) ! HubPtLoad - call MeshUnpack(RF, OutData%NacelleLoads) ! NacelleLoads - call MeshUnpack(RF, OutData%TFinCMLoads) ! TFinCMLoads - call RegUnpackAlloc(RF, OutData%TwrAddedMass); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%PtfmAddedMass); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlPitchCom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawMom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%GenTrq); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%HSSBrTrqC); if (RegCheckErr(RF, RoutineName)) return + call MeshUnpack(RF, OutData%NacelleMotion) ! NacelleMotion + call MeshUnpack(RF, OutData%TFinCMMotion) ! TFinCMMotion + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Yaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawRate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSS_Spd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSS_Spd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrAccel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawAngle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootMyc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrTAxp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrTAyp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipPxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootMxc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMya); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMza); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrMyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrMzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAxs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotPwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFzs); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) - type(ED_OutputType), intent(inout) :: SrcOutputData - type(ED_OutputType), intent(inout) :: DstOutputData +subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(ED_MiscVarType), intent(inout) :: SrcMiscData + type(ED_MiscVarType), intent(inout) :: DstMiscData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'ED_CopyOutput' + character(*), parameter :: RoutineName = 'ED_CopyMisc' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcOutputData%BladeLn2Mesh)) then - LB(1:1) = lbound(SrcOutputData%BladeLn2Mesh) - UB(1:1) = ubound(SrcOutputData%BladeLn2Mesh) - if (.not. allocated(DstOutputData%BladeLn2Mesh)) then - allocate(DstOutputData%BladeLn2Mesh(LB(1):UB(1)), stat=ErrStat2) + call ED_CopyCoordSys(SrcMiscData%CoordSys, DstMiscData%CoordSys, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyRtHndSide(SrcMiscData%RtHS, DstMiscData%RtHS, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeLn2Mesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%BladeLn2Mesh(i1), DstOutputData%BladeLn2Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstMiscData%AllOuts = SrcMiscData%AllOuts end if - call MeshCopy(SrcOutputData%PlatformPtMesh, DstOutputData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcOutputData%TowerLn2Mesh, DstOutputData%TowerLn2Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcOutputData%HubPtMotion, DstOutputData%HubPtMotion, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcOutputData%BladeRootMotion)) then - LB(1:1) = lbound(SrcOutputData%BladeRootMotion) - UB(1:1) = ubound(SrcOutputData%BladeRootMotion) - if (.not. allocated(DstOutputData%BladeRootMotion)) then - allocate(DstOutputData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%AugMat)) then + LB(1:2) = lbound(SrcMiscData%AugMat) + UB(1:2) = ubound(SrcMiscData%AugMat) + if (.not. allocated(DstMiscData%AugMat)) then + allocate(DstMiscData%AugMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeRootMotion.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%BladeRootMotion(i1), DstOutputData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstMiscData%AugMat = SrcMiscData%AugMat end if - call MeshCopy(SrcOutputData%NacelleMotion, DstOutputData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcOutputData%TFinCMMotion, DstOutputData%TFinCMMotion, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) - if (.not. allocated(DstOutputData%WriteOutput)) then - allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%AugMat_factor)) then + LB(1:2) = lbound(SrcMiscData%AugMat_factor) + UB(1:2) = ubound(SrcMiscData%AugMat_factor) + if (.not. allocated(DstMiscData%AugMat_factor)) then + allocate(DstMiscData%AugMat_factor(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_factor.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%WriteOutput = SrcOutputData%WriteOutput + DstMiscData%AugMat_factor = SrcMiscData%AugMat_factor end if - if (allocated(SrcOutputData%BlPitch)) then - LB(1:1) = lbound(SrcOutputData%BlPitch) - UB(1:1) = ubound(SrcOutputData%BlPitch) - if (.not. allocated(DstOutputData%BlPitch)) then - allocate(DstOutputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%SolnVec)) then + LB(1:1) = lbound(SrcMiscData%SolnVec) + UB(1:1) = ubound(SrcMiscData%SolnVec) + if (.not. allocated(DstMiscData%SolnVec)) then + allocate(DstMiscData%SolnVec(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlPitch.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SolnVec.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%BlPitch = SrcOutputData%BlPitch + DstMiscData%SolnVec = SrcMiscData%SolnVec end if - DstOutputData%Yaw = SrcOutputData%Yaw - DstOutputData%YawRate = SrcOutputData%YawRate - DstOutputData%LSS_Spd = SrcOutputData%LSS_Spd - DstOutputData%HSS_Spd = SrcOutputData%HSS_Spd - DstOutputData%RotSpeed = SrcOutputData%RotSpeed - DstOutputData%TwrAccel = SrcOutputData%TwrAccel - DstOutputData%YawAngle = SrcOutputData%YawAngle - DstOutputData%RootMyc = SrcOutputData%RootMyc - DstOutputData%YawBrTAxp = SrcOutputData%YawBrTAxp - DstOutputData%YawBrTAyp = SrcOutputData%YawBrTAyp - DstOutputData%LSSTipPxa = SrcOutputData%LSSTipPxa - DstOutputData%RootMxc = SrcOutputData%RootMxc - DstOutputData%LSSTipMxa = SrcOutputData%LSSTipMxa - DstOutputData%LSSTipMya = SrcOutputData%LSSTipMya - DstOutputData%LSSTipMza = SrcOutputData%LSSTipMza - DstOutputData%LSSTipMys = SrcOutputData%LSSTipMys - DstOutputData%LSSTipMzs = SrcOutputData%LSSTipMzs - DstOutputData%YawBrMyn = SrcOutputData%YawBrMyn - DstOutputData%YawBrMzn = SrcOutputData%YawBrMzn - DstOutputData%NcIMURAxs = SrcOutputData%NcIMURAxs - DstOutputData%NcIMURAys = SrcOutputData%NcIMURAys - DstOutputData%NcIMURAzs = SrcOutputData%NcIMURAzs - DstOutputData%RotPwr = SrcOutputData%RotPwr - DstOutputData%LSShftFxa = SrcOutputData%LSShftFxa - DstOutputData%LSShftFys = SrcOutputData%LSShftFys - DstOutputData%LSShftFzs = SrcOutputData%LSShftFzs + if (allocated(SrcMiscData%AugMat_pivot)) then + LB(1:1) = lbound(SrcMiscData%AugMat_pivot) + UB(1:1) = ubound(SrcMiscData%AugMat_pivot) + if (.not. allocated(DstMiscData%AugMat_pivot)) then + allocate(DstMiscData%AugMat_pivot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_pivot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AugMat_pivot = SrcMiscData%AugMat_pivot + end if + if (allocated(SrcMiscData%OgnlGeAzRo)) then + LB(1:1) = lbound(SrcMiscData%OgnlGeAzRo) + UB(1:1) = ubound(SrcMiscData%OgnlGeAzRo) + if (.not. allocated(DstMiscData%OgnlGeAzRo)) then + allocate(DstMiscData%OgnlGeAzRo(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%OgnlGeAzRo.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%OgnlGeAzRo = SrcMiscData%OgnlGeAzRo + end if + if (allocated(SrcMiscData%QD2T)) then + LB(1:1) = lbound(SrcMiscData%QD2T) + UB(1:1) = ubound(SrcMiscData%QD2T) + if (.not. allocated(DstMiscData%QD2T)) then + allocate(DstMiscData%QD2T(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%QD2T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%QD2T = SrcMiscData%QD2T + end if + DstMiscData%IgnoreMod = SrcMiscData%IgnoreMod + if (allocated(SrcMiscData%OgnlYawRow)) then + LB(1:1) = lbound(SrcMiscData%OgnlYawRow) + UB(1:1) = ubound(SrcMiscData%OgnlYawRow) + if (.not. allocated(DstMiscData%OgnlYawRow)) then + allocate(DstMiscData%OgnlYawRow(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%OgnlYawRow.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%OgnlYawRow = SrcMiscData%OgnlYawRow + end if + DstMiscData%FrcONcRt = SrcMiscData%FrcONcRt + DstMiscData%MomONcRt = SrcMiscData%MomONcRt + DstMiscData%YawFriMz = SrcMiscData%YawFriMz + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine -subroutine ED_DestroyOutput(OutputData, ErrStat, ErrMsg) - type(ED_OutputType), intent(inout) :: OutputData +subroutine ED_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(ED_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'ED_DestroyOutput' + character(*), parameter :: RoutineName = 'ED_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' - if (allocated(OutputData%BladeLn2Mesh)) then - LB(1:1) = lbound(OutputData%BladeLn2Mesh) - UB(1:1) = ubound(OutputData%BladeLn2Mesh) - do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%BladeLn2Mesh(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(OutputData%BladeLn2Mesh) + call ED_DestroyCoordSys(MiscData%CoordSys, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_DestroyRtHndSide(MiscData%RtHS, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if + if (allocated(MiscData%AugMat)) then + deallocate(MiscData%AugMat) end if - call MeshDestroy( OutputData%PlatformPtMesh, ErrStat2, ErrMsg2) + if (allocated(MiscData%AugMat_factor)) then + deallocate(MiscData%AugMat_factor) + end if + if (allocated(MiscData%SolnVec)) then + deallocate(MiscData%SolnVec) + end if + if (allocated(MiscData%AugMat_pivot)) then + deallocate(MiscData%AugMat_pivot) + end if + if (allocated(MiscData%OgnlGeAzRo)) then + deallocate(MiscData%OgnlGeAzRo) + end if + if (allocated(MiscData%QD2T)) then + deallocate(MiscData%QD2T) + end if + if (allocated(MiscData%OgnlYawRow)) then + deallocate(MiscData%OgnlYawRow) + end if + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( OutputData%TowerLn2Mesh, ErrStat2, ErrMsg2) + call ED_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( OutputData%HubPtMotion, ErrStat2, ErrMsg2) + call ED_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(OutputData%BladeRootMotion)) then - LB(1:1) = lbound(OutputData%BladeRootMotion) - UB(1:1) = ubound(OutputData%BladeRootMotion) - do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%BladeRootMotion(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(OutputData%BladeRootMotion) - end if - call MeshDestroy( OutputData%NacelleMotion, ErrStat2, ErrMsg2) + call ED_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( OutputData%TFinCMMotion, ErrStat2, ErrMsg2) + call ED_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(OutputData%WriteOutput)) then - deallocate(OutputData%WriteOutput) - end if - if (allocated(OutputData%BlPitch)) then - deallocate(OutputData%BlPitch) - end if end subroutine -subroutine ED_PackOutput(RF, Indata) +subroutine ED_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF - type(ED_OutputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'ED_PackOutput' - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) + type(ED_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackMisc' if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%BladeLn2Mesh)) - if (allocated(InData%BladeLn2Mesh)) then - call RegPackBounds(RF, 1, lbound(InData%BladeLn2Mesh), ubound(InData%BladeLn2Mesh)) - LB(1:1) = lbound(InData%BladeLn2Mesh) - UB(1:1) = ubound(InData%BladeLn2Mesh) - do i1 = LB(1), UB(1) - call MeshPack(RF, InData%BladeLn2Mesh(i1)) - end do - end if - call MeshPack(RF, InData%PlatformPtMesh) - call MeshPack(RF, InData%TowerLn2Mesh) - call MeshPack(RF, InData%HubPtMotion) - call RegPack(RF, allocated(InData%BladeRootMotion)) - if (allocated(InData%BladeRootMotion)) then - call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) - LB(1:1) = lbound(InData%BladeRootMotion) - UB(1:1) = ubound(InData%BladeRootMotion) - do i1 = LB(1), UB(1) - call MeshPack(RF, InData%BladeRootMotion(i1)) - end do - end if - call MeshPack(RF, InData%NacelleMotion) - call MeshPack(RF, InData%TFinCMMotion) - call RegPackAlloc(RF, InData%WriteOutput) - call RegPackAlloc(RF, InData%BlPitch) - call RegPack(RF, InData%Yaw) - call RegPack(RF, InData%YawRate) - call RegPack(RF, InData%LSS_Spd) - call RegPack(RF, InData%HSS_Spd) - call RegPack(RF, InData%RotSpeed) - call RegPack(RF, InData%TwrAccel) - call RegPack(RF, InData%YawAngle) - call RegPack(RF, InData%RootMyc) - call RegPack(RF, InData%YawBrTAxp) - call RegPack(RF, InData%YawBrTAyp) - call RegPack(RF, InData%LSSTipPxa) - call RegPack(RF, InData%RootMxc) - call RegPack(RF, InData%LSSTipMxa) - call RegPack(RF, InData%LSSTipMya) - call RegPack(RF, InData%LSSTipMza) - call RegPack(RF, InData%LSSTipMys) - call RegPack(RF, InData%LSSTipMzs) - call RegPack(RF, InData%YawBrMyn) - call RegPack(RF, InData%YawBrMzn) - call RegPack(RF, InData%NcIMURAxs) - call RegPack(RF, InData%NcIMURAys) - call RegPack(RF, InData%NcIMURAzs) - call RegPack(RF, InData%RotPwr) - call RegPack(RF, InData%LSShftFxa) - call RegPack(RF, InData%LSShftFys) - call RegPack(RF, InData%LSShftFzs) + call ED_PackCoordSys(RF, InData%CoordSys) + call ED_PackRtHndSide(RF, InData%RtHS) + call RegPackAlloc(RF, InData%AllOuts) + call RegPackAlloc(RF, InData%AugMat) + call RegPackAlloc(RF, InData%AugMat_factor) + call RegPackAlloc(RF, InData%SolnVec) + call RegPackAlloc(RF, InData%AugMat_pivot) + call RegPackAlloc(RF, InData%OgnlGeAzRo) + call RegPackAlloc(RF, InData%QD2T) + call RegPack(RF, InData%IgnoreMod) + call RegPackAlloc(RF, InData%OgnlYawRow) + call RegPack(RF, InData%FrcONcRt) + call RegPack(RF, InData%MomONcRt) + call RegPack(RF, InData%YawFriMz) + call NWTC_Library_PackModJacType(RF, InData%Jac) + call ED_PackContState(RF, InData%x_perturb) + call ED_PackContState(RF, InData%dxdt_lin) + call ED_PackInput(RF, InData%u_perturb) + call ED_PackOutput(RF, InData%y_lin) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ED_UnPackOutput(RF, OutData) +subroutine ED_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF - type(ED_OutputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'ED_UnPackOutput' - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) + type(ED_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackMisc' + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%BladeLn2Mesh)) deallocate(OutData%BladeLn2Mesh) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BladeLn2Mesh(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLn2Mesh.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%BladeLn2Mesh(i1)) ! BladeLn2Mesh - end do - end if - call MeshUnpack(RF, OutData%PlatformPtMesh) ! PlatformPtMesh - call MeshUnpack(RF, OutData%TowerLn2Mesh) ! TowerLn2Mesh - call MeshUnpack(RF, OutData%HubPtMotion) ! HubPtMotion - if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BladeRootMotion(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%BladeRootMotion(i1)) ! BladeRootMotion - end do - end if - call MeshUnpack(RF, OutData%NacelleMotion) ! NacelleMotion - call MeshUnpack(RF, OutData%TFinCMMotion) ! TFinCMMotion - call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlPitch); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Yaw); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawRate); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSS_Spd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%HSS_Spd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TwrAccel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawAngle); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RootMyc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawBrTAxp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawBrTAyp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSSTipPxa); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RootMxc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSSTipMxa); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSSTipMya); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSSTipMza); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSSTipMys); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSSTipMzs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawBrMyn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawBrMzn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NcIMURAxs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NcIMURAys); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NcIMURAzs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RotPwr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSShftFxa); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSShftFys); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSShftFzs); if (RegCheckErr(RF, RoutineName)) return + call ED_UnpackCoordSys(RF, OutData%CoordSys) ! CoordSys + call ED_UnpackRtHndSide(RF, OutData%RtHS) ! RtHS + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AugMat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AugMat_factor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SolnVec); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AugMat_pivot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OgnlGeAzRo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%QD2T); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IgnoreMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OgnlYawRow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FrcONcRt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MomONcRt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawFriMz); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call ED_UnpackContState(RF, OutData%x_perturb) ! x_perturb + call ED_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin + call ED_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call ED_UnpackOutput(RF, OutData%y_lin) ! y_lin end subroutine subroutine ED_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) @@ -7795,5 +7745,581 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err y_out%LSShftFys = a1*y1%LSShftFys + a2*y2%LSShftFys + a3*y3%LSShftFys y_out%LSShftFzs = a1*y1%LSShftFzs + a2*y2%LSShftFzs + a3*y3%LSShftFzs END SUBROUTINE + +function ED_InputMeshPointer(u, DL) result(Mesh) + type(ED_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (ED_u_BladePtLoads) + Mesh => u%BladePtLoads(DL%i1) + case (ED_u_PlatformPtMesh) + Mesh => u%PlatformPtMesh + case (ED_u_TowerPtLoads) + Mesh => u%TowerPtLoads + case (ED_u_HubPtLoad) + Mesh => u%HubPtLoad + case (ED_u_NacelleLoads) + Mesh => u%NacelleLoads + case (ED_u_TFinCMLoads) + Mesh => u%TFinCMLoads + end select +end function + +function ED_OutputMeshPointer(y, DL) result(Mesh) + type(ED_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (ED_y_BladeLn2Mesh) + Mesh => y%BladeLn2Mesh(DL%i1) + case (ED_y_PlatformPtMesh) + Mesh => y%PlatformPtMesh + case (ED_y_TowerLn2Mesh) + Mesh => y%TowerLn2Mesh + case (ED_y_HubPtMotion) + Mesh => y%HubPtMotion + case (ED_y_BladeRootMotion) + Mesh => y%BladeRootMotion(DL%i1) + case (ED_y_NacelleMotion) + Mesh => y%NacelleMotion + case (ED_y_TFinCMMotion) + Mesh => y%TFinCMMotion + end select +end function + +subroutine ED_VarsPackContState(Vars, x, ValAry) + type(ED_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call ED_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine ED_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(ED_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ED_x_QT) + VarVals = x%QT(V%iLB:V%iUB) ! Rank 1 Array + case (ED_x_QDT) + VarVals = x%QDT(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ED_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ED_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call ED_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine ED_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ED_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ED_x_QT) + x%QT(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ED_x_QDT) + x%QDT(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function ED_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ED_x_QT) + Name = "x%QT" + case (ED_x_QDT) + Name = "x%QDT" + case default + Name = "Unknown Field" + end select +end function + +subroutine ED_VarsPackContStateDeriv(Vars, x, ValAry) + type(ED_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call ED_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine ED_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(ED_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ED_x_QT) + VarVals = x%QT(V%iLB:V%iUB) ! Rank 1 Array + case (ED_x_QDT) + VarVals = x%QDT(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ED_VarsPackConstrState(Vars, z, ValAry) + type(ED_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call ED_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine ED_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(ED_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ED_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ED_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ED_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call ED_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine ED_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ED_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ED_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function ED_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ED_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine ED_VarsPackInput(Vars, u, ValAry) + type(ED_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call ED_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine ED_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(ED_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ED_u_BladePtLoads) + call MV_PackMesh(V, u%BladePtLoads(DL%i1), ValAry) ! Mesh + case (ED_u_PlatformPtMesh) + call MV_PackMesh(V, u%PlatformPtMesh, ValAry) ! Mesh + case (ED_u_TowerPtLoads) + call MV_PackMesh(V, u%TowerPtLoads, ValAry) ! Mesh + case (ED_u_HubPtLoad) + call MV_PackMesh(V, u%HubPtLoad, ValAry) ! Mesh + case (ED_u_NacelleLoads) + call MV_PackMesh(V, u%NacelleLoads, ValAry) ! Mesh + case (ED_u_TFinCMLoads) + call MV_PackMesh(V, u%TFinCMLoads, ValAry) ! Mesh + case (ED_u_TwrAddedMass) + VarVals = u%TwrAddedMass(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (ED_u_PtfmAddedMass) + VarVals = u%PtfmAddedMass(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (ED_u_BlPitchCom) + VarVals = u%BlPitchCom(V%iLB:V%iUB) ! Rank 1 Array + case (ED_u_YawMom) + VarVals(1) = u%YawMom ! Scalar + case (ED_u_GenTrq) + VarVals(1) = u%GenTrq ! Scalar + case (ED_u_HSSBrTrqC) + VarVals(1) = u%HSSBrTrqC ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ED_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ED_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call ED_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine ED_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ED_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ED_u_BladePtLoads) + call MV_UnpackMesh(V, ValAry, u%BladePtLoads(DL%i1)) ! Mesh + case (ED_u_PlatformPtMesh) + call MV_UnpackMesh(V, ValAry, u%PlatformPtMesh) ! Mesh + case (ED_u_TowerPtLoads) + call MV_UnpackMesh(V, ValAry, u%TowerPtLoads) ! Mesh + case (ED_u_HubPtLoad) + call MV_UnpackMesh(V, ValAry, u%HubPtLoad) ! Mesh + case (ED_u_NacelleLoads) + call MV_UnpackMesh(V, ValAry, u%NacelleLoads) ! Mesh + case (ED_u_TFinCMLoads) + call MV_UnpackMesh(V, ValAry, u%TFinCMLoads) ! Mesh + case (ED_u_TwrAddedMass) + u%TwrAddedMass(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (ED_u_PtfmAddedMass) + u%PtfmAddedMass(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (ED_u_BlPitchCom) + u%BlPitchCom(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ED_u_YawMom) + u%YawMom = VarVals(1) ! Scalar + case (ED_u_GenTrq) + u%GenTrq = VarVals(1) ! Scalar + case (ED_u_HSSBrTrqC) + u%HSSBrTrqC = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function ED_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ED_u_BladePtLoads) + Name = "u%BladePtLoads("//trim(Num2LStr(DL%i1))//")" + case (ED_u_PlatformPtMesh) + Name = "u%PlatformPtMesh" + case (ED_u_TowerPtLoads) + Name = "u%TowerPtLoads" + case (ED_u_HubPtLoad) + Name = "u%HubPtLoad" + case (ED_u_NacelleLoads) + Name = "u%NacelleLoads" + case (ED_u_TFinCMLoads) + Name = "u%TFinCMLoads" + case (ED_u_TwrAddedMass) + Name = "u%TwrAddedMass" + case (ED_u_PtfmAddedMass) + Name = "u%PtfmAddedMass" + case (ED_u_BlPitchCom) + Name = "u%BlPitchCom" + case (ED_u_YawMom) + Name = "u%YawMom" + case (ED_u_GenTrq) + Name = "u%GenTrq" + case (ED_u_HSSBrTrqC) + Name = "u%HSSBrTrqC" + case default + Name = "Unknown Field" + end select +end function + +subroutine ED_VarsPackOutput(Vars, y, ValAry) + type(ED_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call ED_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine ED_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(ED_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ED_y_BladeLn2Mesh) + call MV_PackMesh(V, y%BladeLn2Mesh(DL%i1), ValAry) ! Mesh + case (ED_y_PlatformPtMesh) + call MV_PackMesh(V, y%PlatformPtMesh, ValAry) ! Mesh + case (ED_y_TowerLn2Mesh) + call MV_PackMesh(V, y%TowerLn2Mesh, ValAry) ! Mesh + case (ED_y_HubPtMotion) + call MV_PackMesh(V, y%HubPtMotion, ValAry) ! Mesh + case (ED_y_BladeRootMotion) + call MV_PackMesh(V, y%BladeRootMotion(DL%i1), ValAry) ! Mesh + case (ED_y_NacelleMotion) + call MV_PackMesh(V, y%NacelleMotion, ValAry) ! Mesh + case (ED_y_TFinCMMotion) + call MV_PackMesh(V, y%TFinCMMotion, ValAry) ! Mesh + case (ED_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case (ED_y_BlPitch) + VarVals = y%BlPitch(V%iLB:V%iUB) ! Rank 1 Array + case (ED_y_Yaw) + VarVals(1) = y%Yaw ! Scalar + case (ED_y_YawRate) + VarVals(1) = y%YawRate ! Scalar + case (ED_y_LSS_Spd) + VarVals(1) = y%LSS_Spd ! Scalar + case (ED_y_HSS_Spd) + VarVals(1) = y%HSS_Spd ! Scalar + case (ED_y_RotSpeed) + VarVals(1) = y%RotSpeed ! Scalar + case (ED_y_TwrAccel) + VarVals(1) = y%TwrAccel ! Scalar + case (ED_y_YawAngle) + VarVals(1) = y%YawAngle ! Scalar + case (ED_y_RootMyc) + VarVals = y%RootMyc(V%iLB:V%iUB) ! Rank 1 Array + case (ED_y_YawBrTAxp) + VarVals(1) = y%YawBrTAxp ! Scalar + case (ED_y_YawBrTAyp) + VarVals(1) = y%YawBrTAyp ! Scalar + case (ED_y_LSSTipPxa) + VarVals(1) = y%LSSTipPxa ! Scalar + case (ED_y_RootMxc) + VarVals = y%RootMxc(V%iLB:V%iUB) ! Rank 1 Array + case (ED_y_LSSTipMxa) + VarVals(1) = y%LSSTipMxa ! Scalar + case (ED_y_LSSTipMya) + VarVals(1) = y%LSSTipMya ! Scalar + case (ED_y_LSSTipMza) + VarVals(1) = y%LSSTipMza ! Scalar + case (ED_y_LSSTipMys) + VarVals(1) = y%LSSTipMys ! Scalar + case (ED_y_LSSTipMzs) + VarVals(1) = y%LSSTipMzs ! Scalar + case (ED_y_YawBrMyn) + VarVals(1) = y%YawBrMyn ! Scalar + case (ED_y_YawBrMzn) + VarVals(1) = y%YawBrMzn ! Scalar + case (ED_y_NcIMURAxs) + VarVals(1) = y%NcIMURAxs ! Scalar + case (ED_y_NcIMURAys) + VarVals(1) = y%NcIMURAys ! Scalar + case (ED_y_NcIMURAzs) + VarVals(1) = y%NcIMURAzs ! Scalar + case (ED_y_RotPwr) + VarVals(1) = y%RotPwr ! Scalar + case (ED_y_LSShftFxa) + VarVals(1) = y%LSShftFxa ! Scalar + case (ED_y_LSShftFys) + VarVals(1) = y%LSShftFys ! Scalar + case (ED_y_LSShftFzs) + VarVals(1) = y%LSShftFzs ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ED_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ED_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call ED_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine ED_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ED_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ED_y_BladeLn2Mesh) + call MV_UnpackMesh(V, ValAry, y%BladeLn2Mesh(DL%i1)) ! Mesh + case (ED_y_PlatformPtMesh) + call MV_UnpackMesh(V, ValAry, y%PlatformPtMesh) ! Mesh + case (ED_y_TowerLn2Mesh) + call MV_UnpackMesh(V, ValAry, y%TowerLn2Mesh) ! Mesh + case (ED_y_HubPtMotion) + call MV_UnpackMesh(V, ValAry, y%HubPtMotion) ! Mesh + case (ED_y_BladeRootMotion) + call MV_UnpackMesh(V, ValAry, y%BladeRootMotion(DL%i1)) ! Mesh + case (ED_y_NacelleMotion) + call MV_UnpackMesh(V, ValAry, y%NacelleMotion) ! Mesh + case (ED_y_TFinCMMotion) + call MV_UnpackMesh(V, ValAry, y%TFinCMMotion) ! Mesh + case (ED_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ED_y_BlPitch) + y%BlPitch(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ED_y_Yaw) + y%Yaw = VarVals(1) ! Scalar + case (ED_y_YawRate) + y%YawRate = VarVals(1) ! Scalar + case (ED_y_LSS_Spd) + y%LSS_Spd = VarVals(1) ! Scalar + case (ED_y_HSS_Spd) + y%HSS_Spd = VarVals(1) ! Scalar + case (ED_y_RotSpeed) + y%RotSpeed = VarVals(1) ! Scalar + case (ED_y_TwrAccel) + y%TwrAccel = VarVals(1) ! Scalar + case (ED_y_YawAngle) + y%YawAngle = VarVals(1) ! Scalar + case (ED_y_RootMyc) + y%RootMyc(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ED_y_YawBrTAxp) + y%YawBrTAxp = VarVals(1) ! Scalar + case (ED_y_YawBrTAyp) + y%YawBrTAyp = VarVals(1) ! Scalar + case (ED_y_LSSTipPxa) + y%LSSTipPxa = VarVals(1) ! Scalar + case (ED_y_RootMxc) + y%RootMxc(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ED_y_LSSTipMxa) + y%LSSTipMxa = VarVals(1) ! Scalar + case (ED_y_LSSTipMya) + y%LSSTipMya = VarVals(1) ! Scalar + case (ED_y_LSSTipMza) + y%LSSTipMza = VarVals(1) ! Scalar + case (ED_y_LSSTipMys) + y%LSSTipMys = VarVals(1) ! Scalar + case (ED_y_LSSTipMzs) + y%LSSTipMzs = VarVals(1) ! Scalar + case (ED_y_YawBrMyn) + y%YawBrMyn = VarVals(1) ! Scalar + case (ED_y_YawBrMzn) + y%YawBrMzn = VarVals(1) ! Scalar + case (ED_y_NcIMURAxs) + y%NcIMURAxs = VarVals(1) ! Scalar + case (ED_y_NcIMURAys) + y%NcIMURAys = VarVals(1) ! Scalar + case (ED_y_NcIMURAzs) + y%NcIMURAzs = VarVals(1) ! Scalar + case (ED_y_RotPwr) + y%RotPwr = VarVals(1) ! Scalar + case (ED_y_LSShftFxa) + y%LSShftFxa = VarVals(1) ! Scalar + case (ED_y_LSShftFys) + y%LSShftFys = VarVals(1) ! Scalar + case (ED_y_LSShftFzs) + y%LSShftFzs = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function ED_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ED_y_BladeLn2Mesh) + Name = "y%BladeLn2Mesh("//trim(Num2LStr(DL%i1))//")" + case (ED_y_PlatformPtMesh) + Name = "y%PlatformPtMesh" + case (ED_y_TowerLn2Mesh) + Name = "y%TowerLn2Mesh" + case (ED_y_HubPtMotion) + Name = "y%HubPtMotion" + case (ED_y_BladeRootMotion) + Name = "y%BladeRootMotion("//trim(Num2LStr(DL%i1))//")" + case (ED_y_NacelleMotion) + Name = "y%NacelleMotion" + case (ED_y_TFinCMMotion) + Name = "y%TFinCMMotion" + case (ED_y_WriteOutput) + Name = "y%WriteOutput" + case (ED_y_BlPitch) + Name = "y%BlPitch" + case (ED_y_Yaw) + Name = "y%Yaw" + case (ED_y_YawRate) + Name = "y%YawRate" + case (ED_y_LSS_Spd) + Name = "y%LSS_Spd" + case (ED_y_HSS_Spd) + Name = "y%HSS_Spd" + case (ED_y_RotSpeed) + Name = "y%RotSpeed" + case (ED_y_TwrAccel) + Name = "y%TwrAccel" + case (ED_y_YawAngle) + Name = "y%YawAngle" + case (ED_y_RootMyc) + Name = "y%RootMyc" + case (ED_y_YawBrTAxp) + Name = "y%YawBrTAxp" + case (ED_y_YawBrTAyp) + Name = "y%YawBrTAyp" + case (ED_y_LSSTipPxa) + Name = "y%LSSTipPxa" + case (ED_y_RootMxc) + Name = "y%RootMxc" + case (ED_y_LSSTipMxa) + Name = "y%LSSTipMxa" + case (ED_y_LSSTipMya) + Name = "y%LSSTipMya" + case (ED_y_LSSTipMza) + Name = "y%LSSTipMza" + case (ED_y_LSSTipMys) + Name = "y%LSSTipMys" + case (ED_y_LSSTipMzs) + Name = "y%LSSTipMzs" + case (ED_y_YawBrMyn) + Name = "y%YawBrMyn" + case (ED_y_YawBrMzn) + Name = "y%YawBrMzn" + case (ED_y_NcIMURAxs) + Name = "y%NcIMURAxs" + case (ED_y_NcIMURAys) + Name = "y%NcIMURAys" + case (ED_y_NcIMURAzs) + Name = "y%NcIMURAzs" + case (ED_y_RotPwr) + Name = "y%RotPwr" + case (ED_y_LSShftFxa) + Name = "y%LSShftFxa" + case (ED_y_LSShftFys) + Name = "y%LSShftFys" + case (ED_y_LSShftFzs) + Name = "y%LSShftFzs" + case default + Name = "Unknown Field" + end select +end function + END MODULE ElastoDyn_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/externalinflow/src/ExternalInflow.f90 b/modules/externalinflow/src/ExternalInflow.f90 index 6f0d1455ae..d85798230e 100644 --- a/modules/externalinflow/src/ExternalInflow.f90 +++ b/modules/externalinflow/src/ExternalInflow.f90 @@ -268,13 +268,20 @@ SUBROUTINE Init_ExtInfw( InitInp, p_FAST, AirDens, u_AD, initOut_AD, y_AD, ExtIn !............................................................................................ CALL AllocAry( InitOut%WriteOutputHdr, 3, 'WriteOutputHdr', ErrStat2, ErrMsg2 ); if (Failed()) return; CALL AllocAry( InitOut%WriteOutputUnt, 3, 'WriteOutputUnt', ErrStat2, ErrMsg2 ); if (Failed()) return; - CALL AllocAry( ExtInfw%y%WriteOutput, 3, 'WriteOutput', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocAry( ExtInfw%y%WriteOutput, 3, 'WriteOutput', ErrStat2, ErrMsg2 ); if (Failed()) return; InitOut%WriteOutputHdr(1) = 'Wind1VelX'; InitOut%WriteOutputUnt(1) = '(m/s)' InitOut%WriteOutputHdr(2) = 'Wind1VelY'; InitOut%WriteOutputUnt(2) = '(m/s)' InitOut%WriteOutputHdr(3) = 'Wind1VelZ'; InitOut%WriteOutputUnt(3) = '(m/s)' ExtInfw%y%WriteOutput = 0.0_ReKi + !............................................................................................ + ! Module Variables + !............................................................................................ + + call ExtInfw_InitVars(ExtInfw%u, ExtInfw%p, ExtInfw%y, ExtInfw%m, InitOut, .false., ErrStat2, ErrMsg2) + if (Failed()) return + InitOut%Ver = ExtInfw_Ver RETURN @@ -292,6 +299,62 @@ logical function Failed2() endif end function Failed2 END SUBROUTINE Init_ExtInfw + +!---------------------------------------------------------------------------------------------------------------------------------- + +subroutine ExtInfw_InitVars(u, p, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(ExtInfw_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(ExtInfw_ParameterType), intent(inout) :: p !< Parameters + type(ExtInfw_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(ExtInfw_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(ExtInfw_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + logical, intent(in ) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'ExtInfw_InitVars' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Add pointers to vars to initialization output + InitOut%Vars => p%Vars + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Initialize Variables and Values + !---------------------------------------------------------------------------- + + CALL MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE ExtInfw_UpdateFlowField(p_FAST, ExtInfw, ErrStat, ErrMsg) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST ! Parameters for the glue code diff --git a/modules/externalinflow/src/ExternalInflow_Registry.txt b/modules/externalinflow/src/ExternalInflow_Registry.txt index 346b559395..bde7687af5 100644 --- a/modules/externalinflow/src/ExternalInflow_Registry.txt +++ b/modules/externalinflow/src/ExternalInflow_Registry.txt @@ -29,8 +29,10 @@ typedef ExternalInflow/ExtInfw InitOutputType CHARACTER(ChanLen) WriteOu typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - typedef ^ InitOutputType FlowFieldType *FlowField - - - "Pointer of flow field data type" - +typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" # ..... MiscVars ................................................................................................................ +typedef ExternalInflow/ExtInfw ExtInfw_MiscVarType ModJacType Jac - - - "Jacobian matrices and arrays corresponding to module variables" typedef ExternalInflow/ExtInfw ExtInfw_MiscVarType MeshType ActForceMotionsPoints {:} - - "point mesh for transferring AeroDyn motions to ExternalInflow (includes hub+blades+nacelle+tower+tailfin)" - typedef ExternalInflow/ExtInfw ExtInfw_MiscVarType MeshType ActForceLoadsPoints {:} - - "point mesh for transferring AeroDyn distributed loads to ExternalInflow (includes hub+blades+nacelle+tower+tailfin)" - typedef ExternalInflow/ExtInfw ExtInfw_MiscVarType MeshMapType Line2_to_Point_Loads {:} - - "mapping data structure to convert line2 loads to point loads" - @@ -39,6 +41,7 @@ typedef ExternalInflow/ExtInfw ExtInfw_MiscVarType FlowFieldType &FlowFi # ..... Parameters ................................................................................................................ +typedef ExternalInflow/ExtInfw ParameterType ModVarsType &Vars - - - "Module Variables" typedef ExternalInflow/ExtInfw ParameterType ReKi AirDens - - - "Air density for normalization of loads sent to ExternalInflow" kg/m^3 typedef ExternalInflow/ExtInfw ParameterType IntKi NumBl - - - "Number of blades" - typedef ExternalInflow/ExtInfw ParameterType IntKi NMappings - - - "Number of mappings" - diff --git a/modules/externalinflow/src/ExternalInflow_Types.f90 b/modules/externalinflow/src/ExternalInflow_Types.f90 index 934490c07a..5c24efa86d 100644 --- a/modules/externalinflow/src/ExternalInflow_Types.f90 +++ b/modules/externalinflow/src/ExternalInflow_Types.f90 @@ -74,6 +74,7 @@ MODULE ExternalInflow_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Pointer of flow field data type [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] END TYPE ExtInfw_InitOutputType ! ======================= ! ========= ExtInfw_MiscVarType_C ======= @@ -82,6 +83,7 @@ MODULE ExternalInflow_Types END TYPE ExtInfw_MiscVarType_C TYPE, PUBLIC :: ExtInfw_MiscVarType TYPE( ExtInfw_MiscVarType_C ) :: C_obj + TYPE(ModJacType) :: Jac !< Jacobian matrices and arrays corresponding to module variables [-] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: ActForceMotionsPoints !< point mesh for transferring AeroDyn motions to ExternalInflow (includes hub+blades+nacelle+tower+tailfin) [-] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: ActForceLoadsPoints !< point mesh for transferring AeroDyn distributed loads to ExternalInflow (includes hub+blades+nacelle+tower+tailfin) [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: Line2_to_Point_Loads !< mapping data structure to convert line2 loads to point loads [-] @@ -110,6 +112,7 @@ MODULE ExternalInflow_Types END TYPE ExtInfw_ParameterType_C TYPE, PUBLIC :: ExtInfw_ParameterType TYPE( ExtInfw_ParameterType_C ) :: C_obj + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density for normalization of loads sent to ExternalInflow [kg/m^3] INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of blades [-] INTEGER(IntKi) :: NMappings = 0_IntKi !< Number of mappings [-] @@ -204,7 +207,29 @@ MODULE ExternalInflow_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] END TYPE ExtInfw_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: ExtInfw_u_pxVel = 1 ! ExtInfw%pxVel + integer(IntKi), public, parameter :: ExtInfw_u_pyVel = 2 ! ExtInfw%pyVel + integer(IntKi), public, parameter :: ExtInfw_u_pzVel = 3 ! ExtInfw%pzVel + integer(IntKi), public, parameter :: ExtInfw_u_pxForce = 4 ! ExtInfw%pxForce + integer(IntKi), public, parameter :: ExtInfw_u_pyForce = 5 ! ExtInfw%pyForce + integer(IntKi), public, parameter :: ExtInfw_u_pzForce = 6 ! ExtInfw%pzForce + integer(IntKi), public, parameter :: ExtInfw_u_xdotForce = 7 ! ExtInfw%xdotForce + integer(IntKi), public, parameter :: ExtInfw_u_ydotForce = 8 ! ExtInfw%ydotForce + integer(IntKi), public, parameter :: ExtInfw_u_zdotForce = 9 ! ExtInfw%zdotForce + integer(IntKi), public, parameter :: ExtInfw_u_pOrientation = 10 ! ExtInfw%pOrientation + integer(IntKi), public, parameter :: ExtInfw_u_fx = 11 ! ExtInfw%fx + integer(IntKi), public, parameter :: ExtInfw_u_fy = 12 ! ExtInfw%fy + integer(IntKi), public, parameter :: ExtInfw_u_fz = 13 ! ExtInfw%fz + integer(IntKi), public, parameter :: ExtInfw_u_momentx = 14 ! ExtInfw%momentx + integer(IntKi), public, parameter :: ExtInfw_u_momenty = 15 ! ExtInfw%momenty + integer(IntKi), public, parameter :: ExtInfw_u_momentz = 16 ! ExtInfw%momentz + integer(IntKi), public, parameter :: ExtInfw_u_forceNodesChord = 17 ! ExtInfw%forceNodesChord + integer(IntKi), public, parameter :: ExtInfw_y_u = 18 ! ExtInfw%u + integer(IntKi), public, parameter :: ExtInfw_y_v = 19 ! ExtInfw%v + integer(IntKi), public, parameter :: ExtInfw_y_w = 20 ! ExtInfw%w + integer(IntKi), public, parameter :: ExtInfw_y_WriteOutput = 21 ! ExtInfw%WriteOutput + +contains subroutine ExtInfw_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(ExtInfw_InitInputType), intent(in) :: SrcInitInputData @@ -465,6 +490,7 @@ subroutine ExtInfw_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstInitOutputData%FlowField => SrcInitOutputData%FlowField + DstInitOutputData%Vars => SrcInitOutputData%Vars end subroutine subroutine ExtInfw_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -485,6 +511,7 @@ subroutine ExtInfw_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(InitOutputData%FlowField) + nullify(InitOutputData%Vars) end subroutine subroutine ExtInfw_PackInitOutput(RF, Indata) @@ -507,6 +534,13 @@ subroutine ExtInfw_PackInitOutput(RF, Indata) call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) end if end if + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -541,6 +575,24 @@ subroutine ExtInfw_UnPackInitOutput(RF, OutData) else OutData%FlowField => null() end if + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if end subroutine SUBROUTINE ExtInfw_C2Fary_CopyInitOutput(InitOutputData, ErrStat, ErrMsg, SkipPointers) @@ -590,6 +642,9 @@ subroutine ExtInfw_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ExtInfw_CopyMisc' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%ActForceMotionsPoints)) then LB(1:1) = lbound(SrcMiscData%ActForceMotionsPoints) UB(1:1) = ubound(SrcMiscData%ActForceMotionsPoints) @@ -679,6 +734,8 @@ subroutine ExtInfw_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ExtInfw_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%ActForceMotionsPoints)) then LB(1:1) = lbound(MiscData%ActForceMotionsPoints) UB(1:1) = ubound(MiscData%ActForceMotionsPoints) @@ -735,6 +792,7 @@ subroutine ExtInfw_PackMisc(RF, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if + call NWTC_Library_PackModJacType(RF, InData%Jac) call RegPack(RF, allocated(InData%ActForceMotionsPoints)) if (allocated(InData%ActForceMotionsPoints)) then call RegPackBounds(RF, 1, lbound(InData%ActForceMotionsPoints), ubound(InData%ActForceMotionsPoints)) @@ -792,6 +850,7 @@ subroutine ExtInfw_UnPackMisc(RF, OutData) integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac if (allocated(OutData%ActForceMotionsPoints)) deallocate(OutData%ActForceMotionsPoints) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -906,9 +965,22 @@ subroutine ExtInfw_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM character(*), intent( out) :: ErrMsg integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtInfw_CopyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if DstParamData%AirDens = SrcParamData%AirDens DstParamData%C_obj%AirDens = SrcParamData%C_obj%AirDens DstParamData%NumBl = SrcParamData%NumBl @@ -967,9 +1039,17 @@ subroutine ExtInfw_DestroyParam(ParamData, ErrStat, ErrMsg) type(ExtInfw_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtInfw_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if if (associated(ParamData%forceBldRnodes)) then deallocate(ParamData%forceBldRnodes) ParamData%forceBldRnodes => null() @@ -994,6 +1074,13 @@ subroutine ExtInfw_PackParam(RF, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if call RegPack(RF, InData%AirDens) call RegPack(RF, InData%NumBl) call RegPack(RF, InData%NMappings) @@ -1020,6 +1107,24 @@ subroutine ExtInfw_UnPackParam(RF, OutData) integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%AirDens = OutData%AirDens call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return @@ -2728,5 +2833,253 @@ SUBROUTINE ExtInfw_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function ExtInfw_InputMeshPointer(u, DL) result(Mesh) + type(ExtInfw_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +function ExtInfw_OutputMeshPointer(y, DL) result(Mesh) + type(ExtInfw_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +subroutine ExtInfw_VarsPackInput(Vars, u, ValAry) + type(ExtInfw_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call ExtInfw_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine ExtInfw_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(ExtInfw_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtInfw_u_pxVel) + VarVals = u%pxVel(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_pyVel) + VarVals = u%pyVel(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_pzVel) + VarVals = u%pzVel(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_pxForce) + VarVals = u%pxForce(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_pyForce) + VarVals = u%pyForce(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_pzForce) + VarVals = u%pzForce(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_xdotForce) + VarVals = u%xdotForce(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_ydotForce) + VarVals = u%ydotForce(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_zdotForce) + VarVals = u%zdotForce(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_pOrientation) + VarVals = u%pOrientation(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_fx) + VarVals = u%fx(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_fy) + VarVals = u%fy(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_fz) + VarVals = u%fz(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_momentx) + VarVals = u%momentx(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_momenty) + VarVals = u%momenty(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_momentz) + VarVals = u%momentz(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_u_forceNodesChord) + VarVals = u%forceNodesChord(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtInfw_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtInfw_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call ExtInfw_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine ExtInfw_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtInfw_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtInfw_u_pxVel) + u%pxVel(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_pyVel) + u%pyVel(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_pzVel) + u%pzVel(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_pxForce) + u%pxForce(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_pyForce) + u%pyForce(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_pzForce) + u%pzForce(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_xdotForce) + u%xdotForce(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_ydotForce) + u%ydotForce(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_zdotForce) + u%zdotForce(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_pOrientation) + u%pOrientation(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_fx) + u%fx(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_fy) + u%fy(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_fz) + u%fz(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_momentx) + u%momentx(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_momenty) + u%momenty(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_momentz) + u%momentz(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_u_forceNodesChord) + u%forceNodesChord(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function ExtInfw_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtInfw_u_pxVel) + Name = "u%pxVel" + case (ExtInfw_u_pyVel) + Name = "u%pyVel" + case (ExtInfw_u_pzVel) + Name = "u%pzVel" + case (ExtInfw_u_pxForce) + Name = "u%pxForce" + case (ExtInfw_u_pyForce) + Name = "u%pyForce" + case (ExtInfw_u_pzForce) + Name = "u%pzForce" + case (ExtInfw_u_xdotForce) + Name = "u%xdotForce" + case (ExtInfw_u_ydotForce) + Name = "u%ydotForce" + case (ExtInfw_u_zdotForce) + Name = "u%zdotForce" + case (ExtInfw_u_pOrientation) + Name = "u%pOrientation" + case (ExtInfw_u_fx) + Name = "u%fx" + case (ExtInfw_u_fy) + Name = "u%fy" + case (ExtInfw_u_fz) + Name = "u%fz" + case (ExtInfw_u_momentx) + Name = "u%momentx" + case (ExtInfw_u_momenty) + Name = "u%momenty" + case (ExtInfw_u_momentz) + Name = "u%momentz" + case (ExtInfw_u_forceNodesChord) + Name = "u%forceNodesChord" + case default + Name = "Unknown Field" + end select +end function + +subroutine ExtInfw_VarsPackOutput(Vars, y, ValAry) + type(ExtInfw_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call ExtInfw_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine ExtInfw_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(ExtInfw_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtInfw_y_u) + VarVals = y%u(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_y_v) + VarVals = y%v(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_y_w) + VarVals = y%w(V%iLB:V%iUB) ! Rank 1 Array + case (ExtInfw_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtInfw_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtInfw_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call ExtInfw_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine ExtInfw_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtInfw_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtInfw_y_u) + y%u(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_y_v) + y%v(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_y_w) + y%w(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtInfw_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function ExtInfw_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtInfw_y_u) + Name = "y%u" + case (ExtInfw_y_v) + Name = "y%v" + case (ExtInfw_y_w) + Name = "y%w" + case (ExtInfw_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE ExternalInflow_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extloads/src/ExtLoads.f90 b/modules/extloads/src/ExtLoads.f90 index d92cba0389..38d37b68f7 100644 --- a/modules/extloads/src/ExtLoads.f90 +++ b/modules/extloads/src/ExtLoads.f90 @@ -26,8 +26,6 @@ module ExtLoads use NWTC_Library use ExtLoads_Types - use InflowWind_IO_Types - use InflowWind_IO implicit none @@ -80,7 +78,6 @@ end subroutine ExtLd_SetInitOut !! The parameters are set here and not changed during the simulation. !! The initial states and initial guess for the input are defined. subroutine ExtLd_Init( InitInp, u, xd, p, y, m, interval, InitOut, ErrStat, ErrMsg ) -!.................................................................................................................................. type(ExtLd_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine type(ExtLd_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined @@ -99,28 +96,23 @@ subroutine ExtLd_Init( InitInp, u, xd, p, y, m, interval, InitOut, ErrStat, ErrM 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 = 'ExtLd_Init' + integer(IntKi) :: ErrStat2 ! temporary error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary error message integer(IntKi) :: i ! loop counter - type(Points_InitInputType) :: Points_InitInput - integer(IntKi) :: errStat2 ! temporary error status of the operation - character(ErrMsgLen) :: errMsg2 ! temporary error message - character(*), parameter :: RoutineName = 'ExtLd_Init' - - - ! Initialize variables for this routine - errStat = ErrID_None errMsg = "" - ! Initialize the NWTC Subroutine Library + !---------------------------------------------------------------------------- + ! Set parameters + !---------------------------------------------------------------------------- - ! Set parameters here p%NumBlds = InitInp%NumBlades + call AllocAry(p%NumBldNds, p%NumBlds, 'NumBldNds', ErrStat2,ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return + if (Failed()) return + p%NumBldNds(:) = InitInp%NumBldNodes(:) p%nTotBldNds = sum(p%NumBldNds(:)) p%NumTwrNds = InitInp%NumTwrNds @@ -129,45 +121,124 @@ subroutine ExtLd_Init( InitInp, u, xd, p, y, m, interval, InitOut, ErrStat, ErrM p%az_blend_mean = InitInp%az_blend_mean p%az_blend_delta = InitInp%az_blend_delta - !............................................................................................ - ! Define and initialize inputs here - !............................................................................................ + !---------------------------------------------------------------------------- + ! Define and initialize inputs + !---------------------------------------------------------------------------- - write(*,*) 'Initializing U ' - - call Init_u( u, p, InitInp, errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return + call Init_u( u, p, InitInp, ErrStat2, ErrMsg2 ) + if (Failed()) return + !---------------------------------------------------------------------------- + ! Initialize misc vars states + !---------------------------------------------------------------------------- - ! Initialize discrete states m%az = 0.0 m%phi_cfd = 0.0 + + !---------------------------------------------------------------------------- + ! Initialize outputs + !---------------------------------------------------------------------------- - write(*,*) 'Initializing y ' - - !............................................................................................ - ! Define outputs here - !............................................................................................ - call Init_y(y, u, m, p, errStat2, errMsg2) ! do this after input meshes have been initialized - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return + ! Initialize outputs after input meshes have been initialized + call Init_y(y, u, m, p, ErrStat2, ErrMsg2) + if (Failed()) return - - !............................................................................................ - ! Define initialization output here - !............................................................................................ - call ExtLd_SetInitOut(p, InitOut, errStat2, errMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !---------------------------------------------------------------------------- + ! Define initialization output here + !---------------------------------------------------------------------------- + call ExtLd_SetInitOut(p, InitOut, errStat2, errMsg2) + if (Failed()) return + + !---------------------------------------------------------------------------- + ! Initialize Module Variables + !---------------------------------------------------------------------------- + + call ExtLd_InitVars(u, p, y, m, InitOut, .false., ErrStat2, ErrMsg2) + if (Failed()) return contains logical function Failed() CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) Failed = ErrStat >= AbortErrLev end function Failed - end subroutine ExtLd_Init + +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine ExtLd_InitVars(u, p, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(ExtLd_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(ExtLd_ParameterType), intent(inout) :: p !< Parameters + type(ExtLd_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(ExtLd_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(ExtLd_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + logical, intent(in ) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'ExtLd_InitVars' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = "" + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Add pointers to vars to initialization output + InitOut%Vars => p%Vars + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + call MV_AddMeshVar(p%Vars%u, "TowerMotion", MotionFields, DatLoc(ExtLd_u_TowerMotion), Mesh=u%TowerMotion) + call MV_AddMeshVar(p%Vars%u, "HubMotion", MotionFields, DatLoc(ExtLd_u_HubMotion), Mesh=u%HubMotion) + call MV_AddMeshVar(p%Vars%u, "NacelleMotion", MotionFields, DatLoc(ExtLd_u_NacelleMotion), Mesh=u%NacelleMotion) + do i = 1, size(u%BladeRootMotion) + call MV_AddMeshVar(p%Vars%u, "BladeRootMotion"//IdxStr(i), MotionFields, DatLoc(ExtLd_u_BladeRootMotion, i), Mesh=u%BladeRootMotion(i)) + end do + do i = 1, size(u%BladeRootMotion) + call MV_AddMeshVar(p%Vars%u, "BladeMotion"//IdxStr(i), MotionFields, DatLoc(ExtLd_u_BladeMotion, i), Mesh=u%BladeMotion(i)) + end do + call MV_AddMeshVar(p%Vars%u, 'TowerLoadAD', LoadFields, DatLoc(ExtLd_u_TowerLoadAD), Mesh=u%TowerLoadAD) + do i = 1, size(u%BladeLoadAD) + call MV_AddMeshVar(p%Vars%u, 'BladeLoadAD'//IdxStr(i), LoadFields, DatLoc(ExtLd_u_BladeLoadAD, i), Mesh=u%BladeLoadAD(i)) + end do + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + call MV_AddMeshVar(p%Vars%y, 'TowerLoad', LoadFields, DatLoc(ExtLd_y_TowerLoad), Mesh=y%TowerLoad) + do i = 1, size(y%BladeLoad) + call MV_AddMeshVar(p%Vars%y, 'BladeLoad'//IdxStr(i), LoadFields, DatLoc(ExtLd_y_BladeLoad, i), Mesh=y%BladeLoad(i)) + end do + + !---------------------------------------------------------------------------- + ! Initialize Variables and Values + !---------------------------------------------------------------------------- + + CALL MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes ExtLoads meshes and output array variables for use during the simulation. subroutine Init_y(y, u, m, p, errStat, errMsg) @@ -205,7 +276,7 @@ subroutine Init_y(y, u, m, p, errStat, errMsg) if (ErrStat >= AbortErrLev) RETURN call MeshCopy ( SrcMesh = u%TowerMotion & - , DestMesh = y%TowerLoadAD & + , DestMesh = u%TowerLoadAD & , CtrlCode = MESH_COUSIN & , IOS = COMPONENT_OUTPUT & , force = .TRUE. & @@ -216,14 +287,14 @@ subroutine Init_y(y, u, m, p, errStat, errMsg) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (ErrStat >= AbortErrLev) RETURN - !call MeshCommit(y%TowerLoadAD, errStat2, errMsg2 ) + !call MeshCommit(u%TowerLoadAD, errStat2, errMsg2 ) !call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) !y%TowerLoad%force = 0.0_ReKi ! shouldn't have to initialize this !y%TowerLoad%moment= 0.0_ReKi ! shouldn't have to initialize this else y%TowerLoad%nnodes = 0 - y%TowerLoadAD%nnodes = 0 + u%TowerLoadAD%nnodes = 0 end if allocate( y%BladeLoad(p%NumBlds), stat=ErrStat2 ) @@ -232,7 +303,7 @@ subroutine Init_y(y, u, m, p, errStat, errMsg) return end if - allocate( y%BladeLoadAD(p%NumBlds), stat=ErrStat2 ) + allocate( u%BladeLoadAD(p%NumBlds), stat=ErrStat2 ) if (errStat2 /= 0) then call SetErrStat( ErrID_Fatal, 'Error allocating y%BladeLoad.', ErrStat, ErrMsg, RoutineName ) return @@ -252,7 +323,7 @@ subroutine Init_y(y, u, m, p, errStat, errMsg) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) call MeshCopy ( SrcMesh = u%BladeMotion(k) & - , DestMesh = y%BladeLoadAD(k) & + , DestMesh = u%BladeLoadAD(k) & , CtrlCode = MESH_COUSIN & , IOS = COMPONENT_OUTPUT & , force = .TRUE. & @@ -262,7 +333,7 @@ subroutine Init_y(y, u, m, p, errStat, errMsg) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !call MeshCommit(y%BladeLoadAD(k), errStat2, errMsg2 ) + !call MeshCommit(u%BladeLoadAD(k), errStat2, errMsg2 ) !call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) @@ -762,16 +833,16 @@ subroutine ExtLd_ConvertOpDataForOpenFAST(y, u, m, p, errStat, errMsg ) if (p%TwrAero) then do j=1,p%NumTwrNds - y%TowerLoad%Force(:,j) = m%phi_cfd * y%DX_y%twrLd((j-1)*6+1:(j-1)*6+3) + (1.0 - m%phi_cfd) * y%TowerLoadAD%Force(:,j) - y%TowerLoad%Moment(:,j) = m%phi_cfd * y%DX_y%twrLd((j-1)*6+4:(j-1)*6+6) + (1.0 - m%phi_cfd) * y%TowerLoadAD%Moment(:,j) + y%TowerLoad%Force(:,j) = m%phi_cfd * y%DX_y%twrLd((j-1)*6+1:(j-1)*6+3) + (1.0 - m%phi_cfd) * u%TowerLoadAD%Force(:,j) + y%TowerLoad%Moment(:,j) = m%phi_cfd * y%DX_y%twrLd((j-1)*6+4:(j-1)*6+6) + (1.0 - m%phi_cfd) * u%TowerLoadAD%Moment(:,j) end do end if jTot = 1 do k=1,p%NumBlds do j=1,p%NumBldNds(k) - y%BladeLoad(k)%Force(:,j) = m%phi_cfd * y%DX_y%bldLd((jTot-1)*6+1:(jTot-1)*6+3) + (1.0 - m%phi_cfd) * y%BladeLoadAD(k)%Force(:,j) - y%BladeLoad(k)%Moment(:,j) = m%phi_cfd * y%DX_y%bldLd((jTot-1)*6+4:(jTot-1)*6+6) + (1.0 - m%phi_cfd) * y%BladeLoadAD(k)%Moment(:,j) + y%BladeLoad(k)%Force(:,j) = m%phi_cfd * y%DX_y%bldLd((jTot-1)*6+1:(jTot-1)*6+3) + (1.0 - m%phi_cfd) * u%BladeLoadAD(k)%Force(:,j) + y%BladeLoad(k)%Moment(:,j) = m%phi_cfd * y%DX_y%bldLd((jTot-1)*6+4:(jTot-1)*6+6) + (1.0 - m%phi_cfd) * u%BladeLoadAD(k)%Moment(:,j) jTot = jTot+1 end do end do @@ -870,7 +941,6 @@ subroutine ExtLd_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt integer(intKi) :: i integer(intKi) :: j @@ -882,6 +952,9 @@ subroutine ExtLd_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs ErrStat = ErrID_None ErrMsg = "" + call ExtLd_ConvertOpDataForOpenFAST(y, u, m, p, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end subroutine ExtLd_CalcOutput subroutine apply_wm(c, v, vrot, transpose) diff --git a/modules/extloads/src/ExtLoadsDX_Types.f90 b/modules/extloads/src/ExtLoadsDX_Types.f90 index 3d8434e68a..8de53a4af7 100644 --- a/modules/extloads/src/ExtLoadsDX_Types.f90 +++ b/modules/extloads/src/ExtLoadsDX_Types.f90 @@ -117,7 +117,16 @@ MODULE ExtLoadsDX_Types REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldLd => NULL() !< Loads on all blades - Externally supplied [-] END TYPE ExtLdDX_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: ExtLdDX_u_twrDef = 1 ! ExtLdDX%twrDef + integer(IntKi), public, parameter :: ExtLdDX_u_bldDef = 2 ! ExtLdDX%bldDef + integer(IntKi), public, parameter :: ExtLdDX_u_hubDef = 3 ! ExtLdDX%hubDef + integer(IntKi), public, parameter :: ExtLdDX_u_nacDef = 4 ! ExtLdDX%nacDef + integer(IntKi), public, parameter :: ExtLdDX_u_bldRootDef = 5 ! ExtLdDX%bldRootDef + integer(IntKi), public, parameter :: ExtLdDX_u_bldPitch = 6 ! ExtLdDX%bldPitch + integer(IntKi), public, parameter :: ExtLdDX_y_twrLd = 7 ! ExtLdDX%twrLd + integer(IntKi), public, parameter :: ExtLdDX_y_bldLd = 8 ! ExtLdDX%bldLd + +contains subroutine ExtLdDX_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) type(ExtLdDX_InputType), intent(in) :: SrcInputData @@ -1681,5 +1690,175 @@ SUBROUTINE ExtLdDX_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat y_out%bldLd = a1*y1%bldLd + a2*y2%bldLd + a3*y3%bldLd END IF ! check if allocated END SUBROUTINE + +function ExtLdDX_InputMeshPointer(u, DL) result(Mesh) + type(ExtLdDX_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +function ExtLdDX_OutputMeshPointer(y, DL) result(Mesh) + type(ExtLdDX_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +subroutine ExtLdDX_VarsPackInput(Vars, u, ValAry) + type(ExtLdDX_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call ExtLdDX_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine ExtLdDX_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(ExtLdDX_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLdDX_u_twrDef) + VarVals = u%twrDef(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLdDX_u_bldDef) + VarVals = u%bldDef(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLdDX_u_hubDef) + VarVals = u%hubDef(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLdDX_u_nacDef) + VarVals = u%nacDef(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLdDX_u_bldRootDef) + VarVals = u%bldRootDef(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLdDX_u_bldPitch) + VarVals = u%bldPitch(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtLdDX_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLdDX_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call ExtLdDX_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine ExtLdDX_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLdDX_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLdDX_u_twrDef) + u%twrDef(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLdDX_u_bldDef) + u%bldDef(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLdDX_u_hubDef) + u%hubDef(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLdDX_u_nacDef) + u%nacDef(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLdDX_u_bldRootDef) + u%bldRootDef(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLdDX_u_bldPitch) + u%bldPitch(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function ExtLdDX_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtLdDX_u_twrDef) + Name = "u%twrDef" + case (ExtLdDX_u_bldDef) + Name = "u%bldDef" + case (ExtLdDX_u_hubDef) + Name = "u%hubDef" + case (ExtLdDX_u_nacDef) + Name = "u%nacDef" + case (ExtLdDX_u_bldRootDef) + Name = "u%bldRootDef" + case (ExtLdDX_u_bldPitch) + Name = "u%bldPitch" + case default + Name = "Unknown Field" + end select +end function + +subroutine ExtLdDX_VarsPackOutput(Vars, y, ValAry) + type(ExtLdDX_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call ExtLdDX_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine ExtLdDX_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(ExtLdDX_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLdDX_y_twrLd) + VarVals = y%twrLd(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLdDX_y_bldLd) + VarVals = y%bldLd(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtLdDX_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLdDX_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call ExtLdDX_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine ExtLdDX_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLdDX_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLdDX_y_twrLd) + y%twrLd(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLdDX_y_bldLd) + y%bldLd(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function ExtLdDX_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtLdDX_y_twrLd) + Name = "y%twrLd" + case (ExtLdDX_y_bldLd) + Name = "y%bldLd" + case default + Name = "Unknown Field" + end select +end function + END MODULE ExtLoadsDX_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extloads/src/ExtLoads_Registry.txt b/modules/extloads/src/ExtLoads_Registry.txt index b287d01a90..cda6e592b3 100644 --- a/modules/extloads/src/ExtLoads_Registry.txt +++ b/modules/extloads/src/ExtLoads_Registry.txt @@ -15,7 +15,6 @@ ################################################################################################################################### # ...... Include files (definitions from NWTC Library) ............................................................................ include Registry_NWTC_Library.txt -include IfW_FlowField.txt usefrom ExtLoadsDX_Registry.txt # ..... Initialization data ....................................................................................................... @@ -47,6 +46,7 @@ typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - typedef ^ InitOutputType ReKi AirDens - - - "Air density" kg/m^3 +typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" # ..... States .................................................................................................................... # Define continuous (differentiable) states here: @@ -58,7 +58,7 @@ typedef ^ DiscreteStateType ReKi blah - - - "Somethin #Defin misc variables here typedef ^ MiscVarType ReKi az - - - "Current azimuth" - typedef ^ MiscVarType ReKi phi_cfd - - - "Blending ratio of load from external driver [0-1]" - -typedef ^ MiscVarType FlowFieldType &FlowField - - - "Flow field data type" - +typedef ^ MiscVarType ModJacType Jac - - - "Jacobian matrices and arrays corresponding to module variables" # Define constraint states here: typedef ^ ConstraintStateType ReKi blah - - - "Something" - @@ -71,6 +71,7 @@ typedef ^ OtherStateType ReKi blah - - - "Som # ..... Parameters ................................................................................................................ # Define parameters here: +typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" typedef ^ ParameterType ExtLdDX_ParameterType DX_p - - - "Data to send to external driver" typedef ^ ParameterType IntKi NumBlds - - - "Number of blades on the turbine" - typedef ^ ParameterType IntKi NumBldNds {:} - - "Number of blade nodes for each blade" - @@ -89,11 +90,12 @@ typedef ^ InputType MeshType HubMotion - - - "motion on the hub" - typedef ^ InputType MeshType NacelleMotion - - - "motion on the nacelle" - typedef ^ InputType MeshType BladeRootMotion {:} - - "motion on each blade root" - typedef ^ InputType MeshType BladeMotion {:} - - "motion on each blade" - +typedef ^ InputType MeshType TowerLoadAD - - - "loads on the tower from aerodyn" - +typedef ^ InputType MeshType BladeLoadAD {:} - - "loads on each blade from aerodyn" - # ..... Outputs ................................................................................................................... # Define outputs that are contained on the mesh here: typedef ^ OutputType ExtLdDX_OutputType DX_y - - - "Data to get from external driver" typedef ^ OutputType MeshType TowerLoad - - - "loads on the tower" - typedef ^ OutputType MeshType BladeLoad {:} - - "loads on each blade" - -typedef ^ OutputType MeshType TowerLoadAD - - - "loads on the tower from aerodyn" - -typedef ^ OutputType MeshType BladeLoadAD {:} - - "loads on each blade from aerodyn" - + diff --git a/modules/extloads/src/ExtLoads_Types.f90 b/modules/extloads/src/ExtLoads_Types.f90 index bccf4a53a5..f694a54b07 100644 --- a/modules/extloads/src/ExtLoads_Types.f90 +++ b/modules/extloads/src/ExtLoads_Types.f90 @@ -31,7 +31,6 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE ExtLoads_Types !--------------------------------------------------------------------------------------------------------------------------------- -USE IfW_FlowField_Types USE ExtLoadsDX_Types USE NWTC_Library IMPLICIT NONE @@ -66,6 +65,7 @@ MODULE ExtLoads_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] END TYPE ExtLd_InitOutputType ! ======================= ! ========= ExtLd_ContinuousStateType ======= @@ -82,7 +82,7 @@ MODULE ExtLoads_Types TYPE, PUBLIC :: ExtLd_MiscVarType REAL(ReKi) :: az = 0.0_ReKi !< Current azimuth [-] REAL(ReKi) :: phi_cfd = 0.0_ReKi !< Blending ratio of load from external driver [0-1] [-] - TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Flow field data type [-] + TYPE(ModJacType) :: Jac !< Jacobian matrices and arrays corresponding to module variables [-] END TYPE ExtLd_MiscVarType ! ======================= ! ========= ExtLd_ConstraintStateType ======= @@ -97,6 +97,7 @@ MODULE ExtLoads_Types ! ======================= ! ========= ExtLd_ParameterType ======= TYPE, PUBLIC :: ExtLd_ParameterType + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] TYPE(ExtLdDX_ParameterType) :: DX_p !< Data to send to external driver [-] INTEGER(IntKi) :: NumBlds = 0_IntKi !< Number of blades on the turbine [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NumBldNds !< Number of blade nodes for each blade [-] @@ -116,6 +117,8 @@ MODULE ExtLoads_Types TYPE(MeshType) :: NacelleMotion !< motion on the nacelle [-] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeRootMotion !< motion on each blade root [-] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeMotion !< motion on each blade [-] + TYPE(MeshType) :: TowerLoadAD !< loads on the tower from aerodyn [-] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeLoadAD !< loads on each blade from aerodyn [-] END TYPE ExtLd_InputType ! ======================= ! ========= ExtLd_OutputType ======= @@ -123,11 +126,30 @@ MODULE ExtLoads_Types TYPE(ExtLdDX_OutputType) :: DX_y !< Data to get from external driver [-] TYPE(MeshType) :: TowerLoad !< loads on the tower [-] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeLoad !< loads on each blade [-] - TYPE(MeshType) :: TowerLoadAD !< loads on the tower from aerodyn [-] - TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeLoadAD !< loads on each blade from aerodyn [-] END TYPE ExtLd_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: ExtLd_x_blah = 1 ! ExtLd%blah + integer(IntKi), public, parameter :: ExtLd_z_blah = 2 ! ExtLd%blah + integer(IntKi), public, parameter :: ExtLd_u_DX_u_twrDef = 3 ! ExtLd%DX_u%twrDef + integer(IntKi), public, parameter :: ExtLd_u_DX_u_bldDef = 4 ! ExtLd%DX_u%bldDef + integer(IntKi), public, parameter :: ExtLd_u_DX_u_hubDef = 5 ! ExtLd%DX_u%hubDef + integer(IntKi), public, parameter :: ExtLd_u_DX_u_nacDef = 6 ! ExtLd%DX_u%nacDef + integer(IntKi), public, parameter :: ExtLd_u_DX_u_bldRootDef = 7 ! ExtLd%DX_u%bldRootDef + integer(IntKi), public, parameter :: ExtLd_u_DX_u_bldPitch = 8 ! ExtLd%DX_u%bldPitch + integer(IntKi), public, parameter :: ExtLd_u_az = 9 ! ExtLd%az + integer(IntKi), public, parameter :: ExtLd_u_TowerMotion = 10 ! ExtLd%TowerMotion + integer(IntKi), public, parameter :: ExtLd_u_HubMotion = 11 ! ExtLd%HubMotion + integer(IntKi), public, parameter :: ExtLd_u_NacelleMotion = 12 ! ExtLd%NacelleMotion + integer(IntKi), public, parameter :: ExtLd_u_BladeRootMotion = 13 ! ExtLd%BladeRootMotion(DL%i1) + integer(IntKi), public, parameter :: ExtLd_u_BladeMotion = 14 ! ExtLd%BladeMotion(DL%i1) + integer(IntKi), public, parameter :: ExtLd_u_TowerLoadAD = 15 ! ExtLd%TowerLoadAD + integer(IntKi), public, parameter :: ExtLd_u_BladeLoadAD = 16 ! ExtLd%BladeLoadAD(DL%i1) + integer(IntKi), public, parameter :: ExtLd_y_DX_y_twrLd = 17 ! ExtLd%DX_y%twrLd + integer(IntKi), public, parameter :: ExtLd_y_DX_y_bldLd = 18 ! ExtLd%DX_y%bldLd + integer(IntKi), public, parameter :: ExtLd_y_TowerLoad = 19 ! ExtLd%TowerLoad + integer(IntKi), public, parameter :: ExtLd_y_BladeLoad = 20 ! ExtLd%BladeLoad(DL%i1) + +contains subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(ExtLd_InitInputType), intent(in) :: SrcInitInputData @@ -426,6 +448,7 @@ subroutine ExtLd_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstInitOutputData%AirDens = SrcInitOutputData%AirDens + DstInitOutputData%Vars => SrcInitOutputData%Vars end subroutine subroutine ExtLd_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -445,17 +468,26 @@ subroutine ExtLd_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitOutputData%Vars) end subroutine subroutine ExtLd_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(ExtLd_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtLd_PackInitOutput' + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) call NWTC_Library_PackProgDesc(RF, InData%Ver) call RegPack(RF, InData%AirDens) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -466,11 +498,31 @@ subroutine ExtLd_UnPackInitOutput(RF, OutData) integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if end subroutine subroutine ExtLd_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -555,7 +607,6 @@ subroutine ExtLd_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: LB(0), UB(0) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtLd_CopyMisc' @@ -563,18 +614,9 @@ subroutine ExtLd_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) ErrMsg = '' DstMiscData%az = SrcMiscData%az DstMiscData%phi_cfd = SrcMiscData%phi_cfd - if (associated(SrcMiscData%FlowField)) then - if (.not. associated(DstMiscData%FlowField)) then - allocate(DstMiscData%FlowField, stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FlowField.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - call IfW_FlowField_CopyFlowFieldType(SrcMiscData%FlowField, DstMiscData%FlowField, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end if + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine ExtLd_DestroyMisc(MiscData, ErrStat, ErrMsg) @@ -586,29 +628,18 @@ subroutine ExtLd_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ExtLd_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' - if (associated(MiscData%FlowField)) then - call IfW_FlowField_DestroyFlowFieldType(MiscData%FlowField, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - deallocate(MiscData%FlowField) - MiscData%FlowField => null() - end if + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ExtLd_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(ExtLd_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtLd_PackMisc' - logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%az) call RegPack(RF, InData%phi_cfd) - call RegPack(RF, associated(InData%FlowField)) - if (associated(InData%FlowField)) then - call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) - if (.not. PtrInIndex) then - call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) - end if - end if + call NWTC_Library_PackModJacType(RF, InData%Jac) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -616,32 +647,10 @@ subroutine ExtLd_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtLd_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtLd_UnPackMisc' - integer(B4Ki) :: LB(0), UB(0) - integer(IntKi) :: stat - logical :: IsAllocAssoc - integer(B8Ki) :: PtrIdx - type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%az); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%phi_cfd); if (RegCheckErr(RF, RoutineName)) return - if (associated(OutData%FlowField)) deallocate(OutData%FlowField) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%FlowField) - else - allocate(OutData%FlowField,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) - call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField - end if - else - OutData%FlowField => null() - end if + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac end subroutine subroutine ExtLd_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -732,6 +741,18 @@ subroutine ExtLd_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg character(*), parameter :: RoutineName = 'ExtLd_CopyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if call ExtLdDX_CopyParam(SrcParamData%DX_p, DstParamData%DX_p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -764,6 +785,12 @@ subroutine ExtLd_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ExtLd_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if call ExtLdDX_DestroyParam(ParamData%DX_p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%NumBldNds)) then @@ -775,7 +802,15 @@ subroutine ExtLd_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(ExtLd_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtLd_PackParam' + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if call ExtLdDX_PackParam(RF, InData%DX_p) call RegPack(RF, InData%NumBlds) call RegPackAlloc(RF, InData%NumBldNds) @@ -794,7 +829,27 @@ subroutine ExtLd_UnPackParam(RF, OutData) integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if call ExtLdDX_UnpackParam(RF, OutData%DX_p) ! DX_p call RegUnpack(RF, OutData%NumBlds); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%NumBldNds); if (RegCheckErr(RF, RoutineName)) return @@ -863,6 +918,25 @@ subroutine ExtLd_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg if (ErrStat >= AbortErrLev) return end do end if + call MeshCopy(SrcInputData%TowerLoadAD, DstInputData%TowerLoadAD, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInputData%BladeLoadAD)) then + LB(1:1) = lbound(SrcInputData%BladeLoadAD) + UB(1:1) = ubound(SrcInputData%BladeLoadAD) + if (.not. allocated(DstInputData%BladeLoadAD)) then + allocate(DstInputData%BladeLoadAD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BladeLoadAD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%BladeLoadAD(i1), DstInputData%BladeLoadAD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if end subroutine subroutine ExtLd_DestroyInput(InputData, ErrStat, ErrMsg) @@ -902,6 +976,17 @@ subroutine ExtLd_DestroyInput(InputData, ErrStat, ErrMsg) end do deallocate(InputData%BladeMotion) end if + call MeshDestroy( InputData%TowerLoadAD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InputData%BladeLoadAD)) then + LB(1:1) = lbound(InputData%BladeLoadAD) + UB(1:1) = ubound(InputData%BladeLoadAD) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%BladeLoadAD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%BladeLoadAD) + end if end subroutine subroutine ExtLd_PackInput(RF, Indata) @@ -934,6 +1019,16 @@ subroutine ExtLd_PackInput(RF, Indata) call MeshPack(RF, InData%BladeMotion(i1)) end do end if + call MeshPack(RF, InData%TowerLoadAD) + call RegPack(RF, allocated(InData%BladeLoadAD)) + if (allocated(InData%BladeLoadAD)) then + call RegPackBounds(RF, 1, lbound(InData%BladeLoadAD), ubound(InData%BladeLoadAD)) + LB(1:1) = lbound(InData%BladeLoadAD) + UB(1:1) = ubound(InData%BladeLoadAD) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeLoadAD(i1)) + end do + end if if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -977,6 +1072,20 @@ subroutine ExtLd_UnPackInput(RF, OutData) call MeshUnpack(RF, OutData%BladeMotion(i1)) ! BladeMotion end do end if + call MeshUnpack(RF, OutData%TowerLoadAD) ! TowerLoadAD + if (allocated(OutData%BladeLoadAD)) deallocate(OutData%BladeLoadAD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeLoadAD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLoadAD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladeLoadAD(i1)) ! BladeLoadAD + end do + end if end subroutine subroutine ExtLd_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -1014,25 +1123,6 @@ subroutine ExtLd_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err if (ErrStat >= AbortErrLev) return end do end if - call MeshCopy(SrcOutputData%TowerLoadAD, DstOutputData%TowerLoadAD, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcOutputData%BladeLoadAD)) then - LB(1:1) = lbound(SrcOutputData%BladeLoadAD) - UB(1:1) = ubound(SrcOutputData%BladeLoadAD) - if (.not. allocated(DstOutputData%BladeLoadAD)) then - allocate(DstOutputData%BladeLoadAD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeLoadAD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%BladeLoadAD(i1), DstOutputData%BladeLoadAD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if end subroutine subroutine ExtLd_DestroyOutput(OutputData, ErrStat, ErrMsg) @@ -1059,17 +1149,6 @@ subroutine ExtLd_DestroyOutput(OutputData, ErrStat, ErrMsg) end do deallocate(OutputData%BladeLoad) end if - call MeshDestroy( OutputData%TowerLoadAD, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(OutputData%BladeLoadAD)) then - LB(1:1) = lbound(OutputData%BladeLoadAD) - UB(1:1) = ubound(OutputData%BladeLoadAD) - do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%BladeLoadAD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(OutputData%BladeLoadAD) - end if end subroutine subroutine ExtLd_PackOutput(RF, Indata) @@ -1090,16 +1169,6 @@ subroutine ExtLd_PackOutput(RF, Indata) call MeshPack(RF, InData%BladeLoad(i1)) end do end if - call MeshPack(RF, InData%TowerLoadAD) - call RegPack(RF, allocated(InData%BladeLoadAD)) - if (allocated(InData%BladeLoadAD)) then - call RegPackBounds(RF, 1, lbound(InData%BladeLoadAD), ubound(InData%BladeLoadAD)) - LB(1:1) = lbound(InData%BladeLoadAD) - UB(1:1) = ubound(InData%BladeLoadAD) - do i1 = LB(1), UB(1) - call MeshPack(RF, InData%BladeLoadAD(i1)) - end do - end if if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1127,20 +1196,6 @@ subroutine ExtLd_UnPackOutput(RF, OutData) call MeshUnpack(RF, OutData%BladeLoad(i1)) ! BladeLoad end do end if - call MeshUnpack(RF, OutData%TowerLoadAD) ! TowerLoadAD - if (allocated(OutData%BladeLoadAD)) deallocate(OutData%BladeLoadAD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BladeLoadAD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLoadAD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%BladeLoadAD(i1)) ! BladeLoadAD - end do - end if end subroutine subroutine ExtLd_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) @@ -1261,6 +1316,14 @@ SUBROUTINE ExtLd_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated + CALL MeshExtrapInterp1(u1%TowerLoadAD, u2%TowerLoadAD, tin, u_out%TowerLoadAD, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%BladeLoadAD) .AND. ALLOCATED(u1%BladeLoadAD)) THEN + do i1 = lbound(u_out%BladeLoadAD,1),ubound(u_out%BladeLoadAD,1) + CALL MeshExtrapInterp1(u1%BladeLoadAD(i1), u2%BladeLoadAD(i1), tin, u_out%BladeLoadAD(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated END SUBROUTINE SUBROUTINE ExtLd_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) @@ -1339,6 +1402,14 @@ SUBROUTINE ExtLd_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated + CALL MeshExtrapInterp2(u1%TowerLoadAD, u2%TowerLoadAD, u3%TowerLoadAD, tin, u_out%TowerLoadAD, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%BladeLoadAD) .AND. ALLOCATED(u1%BladeLoadAD)) THEN + do i1 = lbound(u_out%BladeLoadAD,1),ubound(u_out%BladeLoadAD,1) + CALL MeshExtrapInterp2(u1%BladeLoadAD(i1), u2%BladeLoadAD(i1), u3%BladeLoadAD(i1), tin, u_out%BladeLoadAD(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated END SUBROUTINE subroutine ExtLd_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) @@ -1448,14 +1519,6 @@ SUBROUTINE ExtLd_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated - CALL MeshExtrapInterp1(y1%TowerLoadAD, y2%TowerLoadAD, tin, y_out%TowerLoadAD, tin_out, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ALLOCATED(y_out%BladeLoadAD) .AND. ALLOCATED(y1%BladeLoadAD)) THEN - do i1 = lbound(y_out%BladeLoadAD,1),ubound(y_out%BladeLoadAD,1) - CALL MeshExtrapInterp1(y1%BladeLoadAD(i1), y2%BladeLoadAD(i1), tin, y_out%BladeLoadAD(i1), tin_out, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END DO - END IF ! check if allocated END SUBROUTINE SUBROUTINE ExtLd_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) @@ -1523,14 +1586,392 @@ SUBROUTINE ExtLd_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated - CALL MeshExtrapInterp2(y1%TowerLoadAD, y2%TowerLoadAD, y3%TowerLoadAD, tin, y_out%TowerLoadAD, tin_out, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ALLOCATED(y_out%BladeLoadAD) .AND. ALLOCATED(y1%BladeLoadAD)) THEN - do i1 = lbound(y_out%BladeLoadAD,1),ubound(y_out%BladeLoadAD,1) - CALL MeshExtrapInterp2(y1%BladeLoadAD(i1), y2%BladeLoadAD(i1), y3%BladeLoadAD(i1), tin, y_out%BladeLoadAD(i1), tin_out, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END DO - END IF ! check if allocated END SUBROUTINE + +function ExtLd_InputMeshPointer(u, DL) result(Mesh) + type(ExtLd_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (ExtLd_u_TowerMotion) + Mesh => u%TowerMotion + case (ExtLd_u_HubMotion) + Mesh => u%HubMotion + case (ExtLd_u_NacelleMotion) + Mesh => u%NacelleMotion + case (ExtLd_u_BladeRootMotion) + Mesh => u%BladeRootMotion(DL%i1) + case (ExtLd_u_BladeMotion) + Mesh => u%BladeMotion(DL%i1) + case (ExtLd_u_TowerLoadAD) + Mesh => u%TowerLoadAD + case (ExtLd_u_BladeLoadAD) + Mesh => u%BladeLoadAD(DL%i1) + end select +end function + +function ExtLd_OutputMeshPointer(y, DL) result(Mesh) + type(ExtLd_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (ExtLd_y_TowerLoad) + Mesh => y%TowerLoad + case (ExtLd_y_BladeLoad) + Mesh => y%BladeLoad(DL%i1) + end select +end function + +subroutine ExtLd_VarsPackContState(Vars, x, ValAry) + type(ExtLd_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call ExtLd_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine ExtLd_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(ExtLd_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLd_x_blah) + VarVals(1) = x%blah ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtLd_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLd_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call ExtLd_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine ExtLd_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLd_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLd_x_blah) + x%blah = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function ExtLd_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtLd_x_blah) + Name = "x%blah" + case default + Name = "Unknown Field" + end select +end function + +subroutine ExtLd_VarsPackContStateDeriv(Vars, x, ValAry) + type(ExtLd_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call ExtLd_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine ExtLd_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(ExtLd_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLd_x_blah) + VarVals(1) = x%blah ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtLd_VarsPackConstrState(Vars, z, ValAry) + type(ExtLd_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call ExtLd_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine ExtLd_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(ExtLd_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLd_z_blah) + VarVals(1) = z%blah ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtLd_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLd_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call ExtLd_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine ExtLd_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLd_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLd_z_blah) + z%blah = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function ExtLd_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtLd_z_blah) + Name = "z%blah" + case default + Name = "Unknown Field" + end select +end function + +subroutine ExtLd_VarsPackInput(Vars, u, ValAry) + type(ExtLd_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call ExtLd_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine ExtLd_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(ExtLd_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLd_u_DX_u_twrDef) + VarVals = u%DX_u%twrDef(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLd_u_DX_u_bldDef) + VarVals = u%DX_u%bldDef(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLd_u_DX_u_hubDef) + VarVals = u%DX_u%hubDef(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLd_u_DX_u_nacDef) + VarVals = u%DX_u%nacDef(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLd_u_DX_u_bldRootDef) + VarVals = u%DX_u%bldRootDef(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLd_u_DX_u_bldPitch) + VarVals = u%DX_u%bldPitch(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLd_u_az) + VarVals(1) = u%az ! Scalar + case (ExtLd_u_TowerMotion) + call MV_PackMesh(V, u%TowerMotion, ValAry) ! Mesh + case (ExtLd_u_HubMotion) + call MV_PackMesh(V, u%HubMotion, ValAry) ! Mesh + case (ExtLd_u_NacelleMotion) + call MV_PackMesh(V, u%NacelleMotion, ValAry) ! Mesh + case (ExtLd_u_BladeRootMotion) + call MV_PackMesh(V, u%BladeRootMotion(DL%i1), ValAry) ! Mesh + case (ExtLd_u_BladeMotion) + call MV_PackMesh(V, u%BladeMotion(DL%i1), ValAry) ! Mesh + case (ExtLd_u_TowerLoadAD) + call MV_PackMesh(V, u%TowerLoadAD, ValAry) ! Mesh + case (ExtLd_u_BladeLoadAD) + call MV_PackMesh(V, u%BladeLoadAD(DL%i1), ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtLd_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLd_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call ExtLd_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine ExtLd_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLd_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLd_u_DX_u_twrDef) + u%DX_u%twrDef(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLd_u_DX_u_bldDef) + u%DX_u%bldDef(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLd_u_DX_u_hubDef) + u%DX_u%hubDef(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLd_u_DX_u_nacDef) + u%DX_u%nacDef(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLd_u_DX_u_bldRootDef) + u%DX_u%bldRootDef(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLd_u_DX_u_bldPitch) + u%DX_u%bldPitch(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLd_u_az) + u%az = VarVals(1) ! Scalar + case (ExtLd_u_TowerMotion) + call MV_UnpackMesh(V, ValAry, u%TowerMotion) ! Mesh + case (ExtLd_u_HubMotion) + call MV_UnpackMesh(V, ValAry, u%HubMotion) ! Mesh + case (ExtLd_u_NacelleMotion) + call MV_UnpackMesh(V, ValAry, u%NacelleMotion) ! Mesh + case (ExtLd_u_BladeRootMotion) + call MV_UnpackMesh(V, ValAry, u%BladeRootMotion(DL%i1)) ! Mesh + case (ExtLd_u_BladeMotion) + call MV_UnpackMesh(V, ValAry, u%BladeMotion(DL%i1)) ! Mesh + case (ExtLd_u_TowerLoadAD) + call MV_UnpackMesh(V, ValAry, u%TowerLoadAD) ! Mesh + case (ExtLd_u_BladeLoadAD) + call MV_UnpackMesh(V, ValAry, u%BladeLoadAD(DL%i1)) ! Mesh + end select + end associate +end subroutine + +function ExtLd_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtLd_u_DX_u_twrDef) + Name = "u%DX_u%twrDef" + case (ExtLd_u_DX_u_bldDef) + Name = "u%DX_u%bldDef" + case (ExtLd_u_DX_u_hubDef) + Name = "u%DX_u%hubDef" + case (ExtLd_u_DX_u_nacDef) + Name = "u%DX_u%nacDef" + case (ExtLd_u_DX_u_bldRootDef) + Name = "u%DX_u%bldRootDef" + case (ExtLd_u_DX_u_bldPitch) + Name = "u%DX_u%bldPitch" + case (ExtLd_u_az) + Name = "u%az" + case (ExtLd_u_TowerMotion) + Name = "u%TowerMotion" + case (ExtLd_u_HubMotion) + Name = "u%HubMotion" + case (ExtLd_u_NacelleMotion) + Name = "u%NacelleMotion" + case (ExtLd_u_BladeRootMotion) + Name = "u%BladeRootMotion("//trim(Num2LStr(DL%i1))//")" + case (ExtLd_u_BladeMotion) + Name = "u%BladeMotion("//trim(Num2LStr(DL%i1))//")" + case (ExtLd_u_TowerLoadAD) + Name = "u%TowerLoadAD" + case (ExtLd_u_BladeLoadAD) + Name = "u%BladeLoadAD("//trim(Num2LStr(DL%i1))//")" + case default + Name = "Unknown Field" + end select +end function + +subroutine ExtLd_VarsPackOutput(Vars, y, ValAry) + type(ExtLd_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call ExtLd_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine ExtLd_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(ExtLd_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLd_y_DX_y_twrLd) + VarVals = y%DX_y%twrLd(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLd_y_DX_y_bldLd) + VarVals = y%DX_y%bldLd(V%iLB:V%iUB) ! Rank 1 Array + case (ExtLd_y_TowerLoad) + call MV_PackMesh(V, y%TowerLoad, ValAry) ! Mesh + case (ExtLd_y_BladeLoad) + call MV_PackMesh(V, y%BladeLoad(DL%i1), ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtLd_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLd_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call ExtLd_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine ExtLd_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtLd_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtLd_y_DX_y_twrLd) + y%DX_y%twrLd(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLd_y_DX_y_bldLd) + y%DX_y%bldLd(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtLd_y_TowerLoad) + call MV_UnpackMesh(V, ValAry, y%TowerLoad) ! Mesh + case (ExtLd_y_BladeLoad) + call MV_UnpackMesh(V, ValAry, y%BladeLoad(DL%i1)) ! Mesh + end select + end associate +end subroutine + +function ExtLd_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtLd_y_DX_y_twrLd) + Name = "y%DX_y%twrLd" + case (ExtLd_y_DX_y_bldLd) + Name = "y%DX_y%bldLd" + case (ExtLd_y_TowerLoad) + Name = "y%TowerLoad" + case (ExtLd_y_BladeLoad) + Name = "y%BladeLoad("//trim(Num2LStr(DL%i1))//")" + case default + Name = "Unknown Field" + end select +end function + END MODULE ExtLoads_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extptfm/src/ExtPtfm_MCKF.f90 b/modules/extptfm/src/ExtPtfm_MCKF.f90 index 0af5205be2..fc6772167d 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF.f90 @@ -59,10 +59,6 @@ MODULE ExtPtfm_MCKF PUBLIC :: ExtPtfm_JacobianPConstrState ! Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- ! (Xd), and constraint-state (Z) functions all with respect to the constraint ! states (z) - PUBLIC :: ExtPtfm_GetOP ! Routine to get the operating-point values for linearization (from data structures to arrays) - - - CONTAINS @@ -245,6 +241,10 @@ SUBROUTINE ExtPtfm_Init( InitInp, u, p, x, xd, z, OtherState, y, m, dt_gluecode, InitOut%IsLoad_u = .false. ! the inputs are not loads but kinematics end if + ! --- Module variables + call ExtPtfm_InitVars(u, p, x, y, m, InitOut%Vars, InputFileData, InitInp%Linearize, ErrStat, ErrMsg) + if (Failed()) return + ! --- Summary file if (InputFileData%SumPrint) then call ExtPtfm_PrintSum(x, p, m, InitInp%RootName, ErrStat, ErrMsg); if(Failed()) return @@ -257,6 +257,96 @@ logical function Failed() end function Failed END SUBROUTINE ExtPtfm_Init +subroutine ExtPtfm_InitVars(u, p, x, y, m, Vars, InputFileData, Linearize, ErrStat, ErrMsg) + type(ExtPtfm_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(ExtPtfm_ParameterType), intent(inout) :: p !< Parameters + type(ExtPtfm_ContinuousStateType), intent(inout) :: x !< Continuous state + type(ExtPtfm_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(ExtPtfm_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(ModVarsType), intent(inout) :: Vars !< Module variables + type(ExtPtfm_InputFile), intent(in) :: InputFileData !< Input file data + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'ExtPtfm_InitVars' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + integer(IntKi) :: i, j, k + integer(IntKi), allocatable :: BladeMeshFields(:) + real(R8Ki) :: MaxThrust, MaxTorque, ScaleLength + integer(IntKi) :: Flags, Field + + ErrStat = ErrID_None + ErrMsg = "" + + ! Clear module variables type + call NWTC_Library_DestroyModVarsType(Vars, ErrStat2, ErrMsg2); if (Failed()) return + + !--------------------------------------------------------------------------- + ! Continuous State Variables + !--------------------------------------------------------------------------- + + do i = 1, p%nCB + call MV_AddVar(Vars%x, "Mode"//trim(Num2LStr(p%ActiveCBDOF(i))), FieldTransDisp, & + DL=DatLoc(ExtPtfm_x_qm), iAry=i, & + LinNames=['Mode '//trim(Num2LStr(p%ActiveCBDOF(i)))//' displacement, -']) + end do + + do i = 1, p%nCB + call MV_AddVar(Vars%x, "Mode"//trim(Num2LStr(p%ActiveCBDOF(i))), FieldTransVel, & + DL=DatLoc(ExtPtfm_x_qm), iAry=i, & + LinNames=['Mode '//trim(Num2LStr(p%ActiveCBDOF(i)))//' velocity, -']) + end do + + !--------------------------------------------------------------------------- + ! Input variables + !--------------------------------------------------------------------------- + + call MV_AddMeshVar(Vars%u, 'Interface node', MotionFields, & + DatLoc(ExtPtfm_u_PtfmMesh), & + Mesh=u%PtfmMesh, & + Flags=VF_SmallAngle) + + !--------------------------------------------------------------------------- + ! Output variables + !--------------------------------------------------------------------------- + + call MV_AddMeshVar(Vars%y, "Interface node", LoadFields, & + DL=DatLoc(ExtPtfm_y_PtfmMesh), & + Mesh=y%PtfmMesh) + + call MV_AddVar(Vars%y, p%OutParam(i)%Name, FieldScalar, & + DL=DatLoc(ExtPtfm_y_WriteOutput), & + Num=p%NumOuts, & + Flags=VF_WriteOut, & + LinNames=[(WriteOutLinName(i), i=1, p%NumOuts)]) + + !--------------------------------------------------------------------------- + ! Initialization dependent on linearization + !--------------------------------------------------------------------------- + + call MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + if (Linearize) then + call ExtPtfm_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ExtPtfm_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ExtPtfm_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ExtPtfm_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + end if + +contains + function WriteOutLinName(iParam) result(Name) + integer(IntKi), intent(in) :: iParam + character(LinChanLen) :: Name + Name = trim(p%OutParam(iParam)%Name)//', '//p%OutParam(iParam)%Units + end function + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine !---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE SetStateMatrices( p, ErrStat, ErrMsg) @@ -872,8 +962,8 @@ END SUBROUTINE ExtPtfm_CalcConstrStateResidual !> 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 ExtPtfm_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) -!.................................................................................................................................. +SUBROUTINE ExtPtfm_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(ExtPtfm_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(ExtPtfm_ParameterType), INTENT(IN ) :: p !< Parameters @@ -896,41 +986,67 @@ SUBROUTINE ExtPtfm_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, !! 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] - INTEGER(IntKi) :: i,j ! Loop index - INTEGER(IntKi) :: idx ! Index of output channel in AllOuts - ! Initialize ErrStat + INTEGER(IntKi) :: i, j ! Loop index + logical :: CalcOutputs + ErrStat = ErrID_None ErrMsg = '' + + ! allocate and set dYdu if (present(dYdu)) then - ! allocate and set dYdu + if (.not. allocated(dYdu)) then - call AllocAry(dYdu, N_OUTPUTS+p%NumOuts, N_INPUTS, 'dYdu', ErrStat, ErrMsg); if(Failed()) return - do i=1,size(dYdu,1); do j=1,size(dYdu,2); dYdu(i,j)=0.0_ReKi; enddo;enddo + call AllocAry(dYdu, N_OUTPUTS+p%NumOuts, N_INPUTS, 'dYdu', ErrStat, ErrMsg) + if(Failed()) return + dYdu = 0.0_ReKi end if - dYdu(1:6,1:N_INPUTS) = p%DMat(1:6,1:N_INPUTS) - !dYdu is zero except if WriteOutput is the interface loads - do i = 1,p%NumOuts - idx = p%OutParam(i)%Indx - if (idx==ID_PtfFx) then; dYdu(6+i,1:N_INPUTS) = p%DMat(1,1:N_INPUTS) - elseif (idx==ID_PtfFy) then; dYdu(6+i,1:N_INPUTS) = p%DMat(2,1:N_INPUTS) - elseif (idx==ID_PtfFx) then; dYdu(6+i,1:N_INPUTS) = p%DMat(3,1:N_INPUTS) - elseif (idx==ID_PtfMz) then; dYdu(6+i,1:N_INPUTS) = p%DMat(4,1:N_INPUTS) - elseif (idx==ID_PtfMy) then; dYdu(6+i,1:N_INPUTS) = p%DMat(5,1:N_INPUTS) - elseif (idx==ID_PtfMz) then; dYdu(6+i,1:N_INPUTS) = p%DMat(6,1:N_INPUTS) - else ; dYdu(6+i,1:N_INPUTS) = 0.0_ReKi - endif + + dYdu(1:6, 1:N_INPUTS) = p%DMat(1:6, 1:N_INPUTS) + + ! Check if outputs need to be processed + CalcOutputs = .false. + do i = 1, size(Vars%y) + if (MV_HasFlagsAll(Vars%y(i), VF_WriteOut)) CalcOutputs = .true. end do - end if + + ! dYdu is zero except if WriteOutput is the interface loads + if (CalcOutputs) then + do i = 1, p%NumOuts + select case (p%OutParam(i)%Indx) + case (ID_PtfFx) + dYdu(6+i,1:N_INPUTS) = p%DMat(1,1:N_INPUTS) + case (ID_PtfFy) + dYdu(6+i,1:N_INPUTS) = p%DMat(2,1:N_INPUTS) + case (ID_PtfFz) + dYdu(6+i,1:N_INPUTS) = p%DMat(3,1:N_INPUTS) + case (ID_PtfMx) + dYdu(6+i,1:N_INPUTS) = p%DMat(4,1:N_INPUTS) + case (ID_PtfMy) + dYdu(6+i,1:N_INPUTS) = p%DMat(5,1:N_INPUTS) + case (ID_PtfMz) + dYdu(6+i,1:N_INPUTS) = p%DMat(6,1:N_INPUTS) + case default + dYdu(6+i,1:N_INPUTS) = 0.0_ReKi + end select + end do + end if + end if + + ! allocate and set dXdu if (present(dXdu)) then - ! allocate and set dXdu + if (.not. allocated(dXdu)) then - call AllocAry(dXdu, 2*p%nCB, N_INPUTS, 'dXdu', ErrStat, ErrMsg); if(Failed()) return - do i=1,size(dXdu,1); do j=1,size(dXdu,2); dXdu(i,j)=0.0_ReKi; enddo;enddo + call AllocAry(dXdu, 2*p%nCB, N_INPUTS, 'dXdu', ErrStat, ErrMsg) + if(Failed()) return + dXdu = 0.0_ReKi end if + dXdu(1:2*p%nCB,1:N_INPUTS) = p%BMat(1:2*p%nCB,1:N_INPUTS) end if + if (present(dXddu)) then end if + if (present(dZdu)) then end if CONTAINS @@ -1113,85 +1229,6 @@ SUBROUTINE ExtPtfm_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, Er if (present(dZdz)) then end if END SUBROUTINE ExtPtfm_JacobianPConstrState -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE ExtPtfm_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(ExtPtfm_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(ExtPtfm_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(ExtPtfm_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(ExtPtfm_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(ExtPtfm_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(ExtPtfm_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(ExtPtfm_OutputType), INTENT(IN ) :: y !< Output at operating point - TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - INTEGER(IntKi) :: I - TYPE(ExtPtfm_ContinuousStateType) :: dx !< derivative of continuous states at operating point - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = '' - - if ( present( u_op ) ) then - if (.not. allocated(u_op)) then - call AllocAry(u_op, N_INPUTS, 'u_op', ErrStat, ErrMsg); if(Failed())return - endif - u_op(1:3) = u%PtfmMesh%TranslationDisp(:,1) - u_op(4:6) = GetSmllRotAngs(u%PtfmMesh%Orientation(:,:,1), ErrStat, ErrMsg); if(Failed())return - u_op(7:9 ) = u%PtfmMesh%TranslationVel(:,1) - u_op(10:12) = u%PtfmMesh%RotationVel (:,1) - u_op(13:15) = u%PtfmMesh%TranslationAcc(:,1) - u_op(16:18) = u%PtfmMesh%RotationAcc (:,1) - end if - - if ( present( y_op ) ) then - if (.not. allocated(y_op)) then - call AllocAry(y_op, N_OUTPUTS+p%NumOuts, 'y_op', ErrStat, ErrMsg); if(Failed())return - endif - ! Update the output mesh - y_op(1:3)=y%PtfmMesh%Force(1:3,1) - y_op(4:6)=y%PtfmMesh%Moment(1:3,1) - do i=1,p%NumOuts - y_op(i+N_OUTPUTS) = y%WriteOutput(i) - end do - end if - - if ( present( x_op ) ) then - if (.not. allocated(x_op)) then - call AllocAry(x_op, 2*p%nCB, 'x_op', ErrStat, ErrMsg); if (Failed())return - endif - x_op(1:p%nCB) = x%qm(1:p%nCB) - x_op(p%nCB+1:2*p%nCB) = x%qmdot(1:p%nCB) - end if - - if ( present( dx_op ) ) then - if (.not. allocated(dx_op)) then - call AllocAry(dx_op, 2*p%nCB, 'dx_op', ErrStat, ErrMsg); if (Failed())return - endif - call ExtPtfm_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, dx, ErrStat, ErrMsg); if(Failed()) return - dx_op(1:p%nCB) = dx%qm(1:p%nCB) - dx_op(p%nCB+1:2*p%nCB) = dx%qmdot(1:p%nCB) - end if - - if ( present( xd_op ) ) then - end if - - if ( present( z_op ) ) then - end if - -contains - logical function Failed() - CALL SetErrStatSimple(ErrStat, ErrMsg, 'ExtPtfm_GetOP') - Failed = ErrStat >= AbortErrLev - end function Failed -END SUBROUTINE ExtPtfm_GetOP !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ END MODULE ExtPtfm_MCKF diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Registry.txt b/modules/extptfm/src/ExtPtfm_MCKF_Registry.txt index 4297d50b33..a65b5405b8 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Registry.txt +++ b/modules/extptfm/src/ExtPtfm_MCKF_Registry.txt @@ -54,8 +54,8 @@ typedef ^ ^ LOGICAL RotFrame_y { typedef ^ ^ LOGICAL RotFrame_x {:} - - "Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame" - typedef ^ ^ LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - typedef ^ ^ LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - -typedef ^ ^ IntKi DerivOrder_x {:} - - "Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization" - - +typedef ^ ^ IntKi DerivOrder_x {:} - - "Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization" - +typedef ^ ^ ModVarsType Vars - - - "Module variables" # ..... States .................................................................................................................... # Define continuous (differentiable) states here: @@ -74,17 +74,6 @@ typedef ^ ^ IntKi n #typedef ^ OtherStateType IntKi DummyOtherState - - - "Remove this variable if you have other states" - -# ..... Misc/Optimization variables................................................................................................. -# Define any data that are used only for efficiency purposes (these variables are not associated with time): -# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. -typedef ^ MiscVarType ReKi xFlat {:} - - "Flattened vector of states" -typedef ^ MiscVarType ReKi uFlat {18} - - "Flattened vector of inputs" -typedef ^ MiscVarType ReKi F_at_t {:} - - "The 6 interface loads and Craig-Bampton loads at t (force and moment acting at the platform reference (no added-mass effects); positive forces are in the direction of motion)." "N, N-m" -typedef ^ MiscVarType IntKi Indx - - - "Index into times, to speed up interpolation" - -typedef ^ MiscVarType LOGICAL EquilStart - - - "Flag to determine the equilibrium position of the CB DOF at initialization (first call)" - -typedef ^ ^ ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" "see OutListParameters.xlsx spreadsheet" - - # ..... Parameters ................................................................................................................ # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: @@ -128,3 +117,17 @@ typedef ^ InputType MeshType PtfmMesh - typedef ^ OutputType MeshType PtfmMesh - - - "Loads at the platform reference point" - typedef ^ ^ ReKi WriteOutput {:} - - "Example of data to be written to an output file" "s,-" +# ..... Misc/Optimization variables................................................................................................. +# Define any data that are used only for efficiency purposes (these variables are not associated with time): +# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. +typedef ^ MiscVarType ReKi xFlat {:} - - "Flattened vector of states" +typedef ^ MiscVarType ReKi uFlat {18} - - "Flattened vector of inputs" +typedef ^ MiscVarType ReKi F_at_t {:} - - "The 6 interface loads and Craig-Bampton loads at t (force and moment acting at the platform reference (no added-mass effects); positive forces are in the direction of motion)." "N, N-m" +typedef ^ MiscVarType IntKi Indx - - - "Index into times, to speed up interpolation" - +typedef ^ MiscVarType LOGICAL EquilStart - - - "Flag to determine the equilibrium position of the CB DOF at initialization (first call)" - +typedef ^ ^ ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" "see OutListParameters.xlsx spreadsheet" +typedef ^ ^ ModJacType Jac - - - "Data structure for calculating module Jacobians" - +typedef ^ ^ ExtPtfm_ContinuousStateType x_perturb - - - "" - +typedef ^ ^ ExtPtfm_ContinuousStateType dxdt_lin - - - "continuous state derivatives" - +typedef ^ ^ ExtPtfm_InputType u_perturb - - - "" - +typedef ^ ^ ExtPtfm_OutputType y_lin - - - "" - diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index 40c63127cb..798feb7b98 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -74,6 +74,7 @@ MODULE ExtPtfm_MCKF_Types LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DerivOrder_x !< Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization [-] + TYPE(ModVarsType) :: Vars !< Module variables [-] END TYPE ExtPtfm_InitOutputType ! ======================= ! ========= ExtPtfm_ContinuousStateType ======= @@ -98,16 +99,6 @@ MODULE ExtPtfm_MCKF_Types INTEGER(IntKi) :: n = 0_IntKi !< Tracks time step for which OtherState was updated last [-] END TYPE ExtPtfm_OtherStateType ! ======================= -! ========= ExtPtfm_MiscVarType ======= - TYPE, PUBLIC :: ExtPtfm_MiscVarType - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: xFlat !< Flattened vector of states [-] - REAL(ReKi) , DIMENSION(1:18) :: uFlat = 0.0_ReKi !< Flattened vector of inputs [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_at_t !< The 6 interface loads and Craig-Bampton loads at t (force and moment acting at the platform reference (no added-mass effects); positive forces are in the direction of motion). [N, N-m] - INTEGER(IntKi) :: Indx = 0_IntKi !< Index into times, to speed up interpolation [-] - LOGICAL :: EquilStart = .false. !< Flag to determine the equilibrium position of the CB DOF at initialization (first call) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [see OutListParameters.xlsx spreadsheet] - END TYPE ExtPtfm_MiscVarType -! ======================= ! ========= ExtPtfm_ParameterType ======= TYPE, PUBLIC :: ExtPtfm_ParameterType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Mass !< Mass matrix [kg, kg-m, kg-m^2] @@ -154,7 +145,29 @@ MODULE ExtPtfm_MCKF_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Example of data to be written to an output file [s,-] END TYPE ExtPtfm_OutputType ! ======================= -CONTAINS +! ========= ExtPtfm_MiscVarType ======= + TYPE, PUBLIC :: ExtPtfm_MiscVarType + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: xFlat !< Flattened vector of states [-] + REAL(ReKi) , DIMENSION(1:18) :: uFlat = 0.0_ReKi !< Flattened vector of inputs [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_at_t !< The 6 interface loads and Craig-Bampton loads at t (force and moment acting at the platform reference (no added-mass effects); positive forces are in the direction of motion). [N, N-m] + INTEGER(IntKi) :: Indx = 0_IntKi !< Index into times, to speed up interpolation [-] + LOGICAL :: EquilStart = .false. !< Flag to determine the equilibrium position of the CB DOF at initialization (first call) [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [see OutListParameters.xlsx spreadsheet] + TYPE(ModJacType) :: Jac !< Data structure for calculating module Jacobians [-] + TYPE(ExtPtfm_ContinuousStateType) :: x_perturb !< [-] + TYPE(ExtPtfm_ContinuousStateType) :: dxdt_lin !< continuous state derivatives [-] + TYPE(ExtPtfm_InputType) :: u_perturb !< [-] + TYPE(ExtPtfm_OutputType) :: y_lin !< [-] + END TYPE ExtPtfm_MiscVarType +! ======================= + integer(IntKi), public, parameter :: ExtPtfm_x_qm = 1 ! ExtPtfm%qm + integer(IntKi), public, parameter :: ExtPtfm_x_qmdot = 2 ! ExtPtfm%qmdot + integer(IntKi), public, parameter :: ExtPtfm_z_DummyConstrState = 3 ! ExtPtfm%DummyConstrState + integer(IntKi), public, parameter :: ExtPtfm_u_PtfmMesh = 4 ! ExtPtfm%PtfmMesh + integer(IntKi), public, parameter :: ExtPtfm_y_PtfmMesh = 5 ! ExtPtfm%PtfmMesh + integer(IntKi), public, parameter :: ExtPtfm_y_WriteOutput = 6 ! ExtPtfm%WriteOutput + +contains subroutine ExtPtfm_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(ExtPtfm_InitInputType), intent(in) :: SrcInitInputData @@ -482,6 +495,9 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode end if DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x end if + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine ExtPtfm_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -525,6 +541,8 @@ subroutine ExtPtfm_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%DerivOrder_x)) then deallocate(InitOutputData%DerivOrder_x) end if + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ExtPtfm_PackInitOutput(RF, Indata) @@ -543,6 +561,7 @@ subroutine ExtPtfm_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%RotFrame_u) call RegPackAlloc(RF, InData%IsLoad_u) call RegPackAlloc(RF, InData%DerivOrder_x) + call NWTC_Library_PackModVarsType(RF, InData%Vars) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -565,6 +584,7 @@ subroutine ExtPtfm_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end subroutine subroutine ExtPtfm_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -816,106 +836,6 @@ subroutine ExtPtfm_UnPackOtherState(RF, OutData) call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ExtPtfm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(ExtPtfm_MiscVarType), intent(in) :: SrcMiscData - type(ExtPtfm_MiscVarType), intent(inout) :: DstMiscData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'ExtPtfm_CopyMisc' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcMiscData%xFlat)) then - LB(1:1) = lbound(SrcMiscData%xFlat) - UB(1:1) = ubound(SrcMiscData%xFlat) - if (.not. allocated(DstMiscData%xFlat)) then - allocate(DstMiscData%xFlat(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%xFlat.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%xFlat = SrcMiscData%xFlat - end if - DstMiscData%uFlat = SrcMiscData%uFlat - if (allocated(SrcMiscData%F_at_t)) then - LB(1:1) = lbound(SrcMiscData%F_at_t) - UB(1:1) = ubound(SrcMiscData%F_at_t) - if (.not. allocated(DstMiscData%F_at_t)) then - allocate(DstMiscData%F_at_t(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_at_t.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%F_at_t = SrcMiscData%F_at_t - end if - DstMiscData%Indx = SrcMiscData%Indx - DstMiscData%EquilStart = SrcMiscData%EquilStart - if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts) - UB(1:1) = ubound(SrcMiscData%AllOuts) - if (.not. allocated(DstMiscData%AllOuts)) then - allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%AllOuts = SrcMiscData%AllOuts - end if -end subroutine - -subroutine ExtPtfm_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(ExtPtfm_MiscVarType), intent(inout) :: MiscData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'ExtPtfm_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(MiscData%xFlat)) then - deallocate(MiscData%xFlat) - end if - if (allocated(MiscData%F_at_t)) then - deallocate(MiscData%F_at_t) - end if - if (allocated(MiscData%AllOuts)) then - deallocate(MiscData%AllOuts) - end if -end subroutine - -subroutine ExtPtfm_PackMisc(RF, Indata) - type(RegFile), intent(inout) :: RF - type(ExtPtfm_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'ExtPtfm_PackMisc' - if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%xFlat) - call RegPack(RF, InData%uFlat) - call RegPackAlloc(RF, InData%F_at_t) - call RegPack(RF, InData%Indx) - call RegPack(RF, InData%EquilStart) - call RegPackAlloc(RF, InData%AllOuts) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine ExtPtfm_UnPackMisc(RF, OutData) - type(RegFile), intent(inout) :: RF - type(ExtPtfm_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'ExtPtfm_UnPackMisc' - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%xFlat); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%uFlat); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%F_at_t); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Indx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%EquilStart); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return -end subroutine - subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) type(ExtPtfm_ParameterType), intent(in) :: SrcParamData type(ExtPtfm_ParameterType), intent(inout) :: DstParamData @@ -1537,6 +1457,144 @@ subroutine ExtPtfm_UnPackOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine +subroutine ExtPtfm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_MiscVarType), intent(inout) :: SrcMiscData + type(ExtPtfm_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%xFlat)) then + LB(1:1) = lbound(SrcMiscData%xFlat) + UB(1:1) = ubound(SrcMiscData%xFlat) + if (.not. allocated(DstMiscData%xFlat)) then + allocate(DstMiscData%xFlat(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%xFlat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%xFlat = SrcMiscData%xFlat + end if + DstMiscData%uFlat = SrcMiscData%uFlat + if (allocated(SrcMiscData%F_at_t)) then + LB(1:1) = lbound(SrcMiscData%F_at_t) + UB(1:1) = ubound(SrcMiscData%F_at_t) + if (.not. allocated(DstMiscData%F_at_t)) then + allocate(DstMiscData%F_at_t(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_at_t.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_at_t = SrcMiscData%F_at_t + end if + DstMiscData%Indx = SrcMiscData%Indx + DstMiscData%EquilStart = SrcMiscData%EquilStart + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AllOuts = SrcMiscData%AllOuts + end if + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtPtfm_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtPtfm_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtPtfm_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtPtfm_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine ExtPtfm_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(ExtPtfm_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%xFlat)) then + deallocate(MiscData%xFlat) + end if + if (allocated(MiscData%F_at_t)) then + deallocate(MiscData%F_at_t) + end if + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtPtfm_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtPtfm_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtPtfm_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtPtfm_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ExtPtfm_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%xFlat) + call RegPack(RF, InData%uFlat) + call RegPackAlloc(RF, InData%F_at_t) + call RegPack(RF, InData%Indx) + call RegPack(RF, InData%EquilStart) + call RegPackAlloc(RF, InData%AllOuts) + call NWTC_Library_PackModJacType(RF, InData%Jac) + call ExtPtfm_PackContState(RF, InData%x_perturb) + call ExtPtfm_PackContState(RF, InData%dxdt_lin) + call ExtPtfm_PackInput(RF, InData%u_perturb) + call ExtPtfm_PackOutput(RF, InData%y_lin) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackMisc' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%xFlat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%uFlat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_at_t); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EquilStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call ExtPtfm_UnpackContState(RF, OutData%x_perturb) ! x_perturb + call ExtPtfm_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin + call ExtPtfm_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call ExtPtfm_UnpackOutput(RF, OutData%y_lin) ! y_lin +end subroutine + subroutine ExtPtfm_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time @@ -1858,5 +1916,295 @@ SUBROUTINE ExtPtfm_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function ExtPtfm_InputMeshPointer(u, DL) result(Mesh) + type(ExtPtfm_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (ExtPtfm_u_PtfmMesh) + Mesh => u%PtfmMesh + end select +end function + +function ExtPtfm_OutputMeshPointer(y, DL) result(Mesh) + type(ExtPtfm_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (ExtPtfm_y_PtfmMesh) + Mesh => y%PtfmMesh + end select +end function + +subroutine ExtPtfm_VarsPackContState(Vars, x, ValAry) + type(ExtPtfm_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call ExtPtfm_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine ExtPtfm_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(ExtPtfm_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtPtfm_x_qm) + VarVals = x%qm(V%iLB:V%iUB) ! Rank 1 Array + case (ExtPtfm_x_qmdot) + VarVals = x%qmdot(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtPtfm_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtPtfm_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call ExtPtfm_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine ExtPtfm_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtPtfm_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtPtfm_x_qm) + x%qm(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (ExtPtfm_x_qmdot) + x%qmdot(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function ExtPtfm_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtPtfm_x_qm) + Name = "x%qm" + case (ExtPtfm_x_qmdot) + Name = "x%qmdot" + case default + Name = "Unknown Field" + end select +end function + +subroutine ExtPtfm_VarsPackContStateDeriv(Vars, x, ValAry) + type(ExtPtfm_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call ExtPtfm_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine ExtPtfm_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(ExtPtfm_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtPtfm_x_qm) + VarVals = x%qm(V%iLB:V%iUB) ! Rank 1 Array + case (ExtPtfm_x_qmdot) + VarVals = x%qmdot(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtPtfm_VarsPackConstrState(Vars, z, ValAry) + type(ExtPtfm_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call ExtPtfm_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine ExtPtfm_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(ExtPtfm_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtPtfm_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtPtfm_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtPtfm_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call ExtPtfm_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine ExtPtfm_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtPtfm_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtPtfm_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function ExtPtfm_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtPtfm_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine ExtPtfm_VarsPackInput(Vars, u, ValAry) + type(ExtPtfm_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call ExtPtfm_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine ExtPtfm_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(ExtPtfm_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtPtfm_u_PtfmMesh) + call MV_PackMesh(V, u%PtfmMesh, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtPtfm_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtPtfm_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call ExtPtfm_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine ExtPtfm_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtPtfm_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtPtfm_u_PtfmMesh) + call MV_UnpackMesh(V, ValAry, u%PtfmMesh) ! Mesh + end select + end associate +end subroutine + +function ExtPtfm_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtPtfm_u_PtfmMesh) + Name = "u%PtfmMesh" + case default + Name = "Unknown Field" + end select +end function + +subroutine ExtPtfm_VarsPackOutput(Vars, y, ValAry) + type(ExtPtfm_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call ExtPtfm_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine ExtPtfm_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(ExtPtfm_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtPtfm_y_PtfmMesh) + call MV_PackMesh(V, y%PtfmMesh, ValAry) ! Mesh + case (ExtPtfm_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine ExtPtfm_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(ExtPtfm_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call ExtPtfm_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine ExtPtfm_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(ExtPtfm_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (ExtPtfm_y_PtfmMesh) + call MV_UnpackMesh(V, ValAry, y%PtfmMesh) ! Mesh + case (ExtPtfm_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function ExtPtfm_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (ExtPtfm_y_PtfmMesh) + Name = "y%PtfmMesh" + case (ExtPtfm_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE ExtPtfm_MCKF_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/feamooring/src/FEAM.f90 b/modules/feamooring/src/FEAM.f90 index a97aeee76b..f1d01cdc70 100644 --- a/modules/feamooring/src/FEAM.f90 +++ b/modules/feamooring/src/FEAM.f90 @@ -284,6 +284,14 @@ SUBROUTINE FEAM_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, I IF (ErrStat >= AbortErrLev) RETURN y%WriteOutput = 0 + !............................................................................................ + ! Module Variables + !............................................................................................ + + call FEAM_InitVars(u, p, x, y, misc, InitOut, .false., ErrStat2, ErrMsg2) + call CheckError( ErrStat2, ErrMsg2 ) + if (ErrStat >= AbortErrLev) return + !............................................................................................ ! 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: @@ -332,6 +340,71 @@ END SUBROUTINE CheckError !---------------------------------------------------------------------------------------------------------------------------------- END SUBROUTINE FEAM_Init !---------------------------------------------------------------------------------------------------------------------------------- + +subroutine FEAM_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(FEAM_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(FEAM_ParameterType), intent(inout) :: p !< Parameters + type(FEAM_ContinuousStateType), intent(inout) :: x !< Continuous state + type(FEAM_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(FEAM_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(FEAM_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + logical, intent(in ) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'FEAM_InitVars' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + integer(IntKi) :: i, j, Flags, idx + + ErrStat = ErrID_None + ErrMsg = "" + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Add pointers to vars to initialization output + InitOut%Vars => p%Vars + + !--------------------------------------------------------------------------- + ! Continuous State Variables + !--------------------------------------------------------------------------- + + !--------------------------------------------------------------------------- + ! Input variables + !--------------------------------------------------------------------------- + + call MV_AddMeshVar(p%Vars%u, "PtFairleadDisplacement", [FieldTransDisp], & + DatLoc(FEAM_u_PtFairleadDisplacement), & + Mesh=u%PtFairleadDisplacement) + + !--------------------------------------------------------------------------- + ! Output variables + !--------------------------------------------------------------------------- + + call MV_AddMeshVar(p%Vars%y, 'PtFairleadLoad', [FieldForce], & + DatLoc(FEAM_y_PtFairleadLoad), & + Mesh=y%PtFairleadLoad) + + !--------------------------------------------------------------------------- + ! Initialize Variables and Values + !--------------------------------------------------------------------------- + + CALL MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed + end subroutine +!---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE Init_States(p, x, xd, z, OtherState, ErrStat, ErrMsg) TYPE(FEAM_ParameterType), INTENT(IN ) :: p ! Parameters diff --git a/modules/feamooring/src/FEAM_Registry.txt b/modules/feamooring/src/FEAM_Registry.txt index c0482b23bd..1d4030418a 100644 --- a/modules/feamooring/src/FEAM_Registry.txt +++ b/modules/feamooring/src/FEAM_Registry.txt @@ -69,6 +69,7 @@ typedef ^ ^ ReKi WtrDens - typedef FEAMooring/FEAM InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - typedef ^ ^ ProgDesc Ver - - - "This module's name, version, and date" - +typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables" - typedef ^ ^ ReKi LAnchxi {:} - - "Anchor coordinate" - typedef ^ ^ ReKi LAnchyi {:} - - "Anchor coordinate" - typedef ^ ^ ReKi LAnchzi {:} - - "Anchor coordinate" - @@ -114,7 +115,8 @@ typedef ^ ^ ReKi EMAS0 {15}{1 # Define any data that are used only for efficiency purposes (these variables are not associated with time): # e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. # these could be local variables: -typedef ^ MiscVarType ReKi GLF {:}{:} - - "Global forcing matrix" - +typedef ^ MiscVarType ModJacType Jac - - - "Jacobian matrices and arrays corresponding to module variables" +typedef ^ ^ ReKi GLF {:}{:} - - "Global forcing matrix" - typedef ^ ^ ReKi GLK {:}{:}{:} - - "Global stiffness matrix" - typedef ^ ^ ReKi EMASS {15}{15} - - "Line element mass" typedef ^ ^ ReKi ESTIF {15}{15} - - "Line element stiffness" @@ -147,6 +149,7 @@ typedef ^ ^ IntKi LastIndWave - # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: typedef FEAMooring/FEAM ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds typedef ^ ^ ReKi GRAV {3} - - "Gravity" - +typedef ^ ^ ModVarsType &Vars - - - "Module Variables" # parameters from Mooring typedef ^ ^ ReKi Eps - - - "Tolerance for static iteration" typedef ^ ^ ReKi Gravity - - - "Gravity" diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index 986f9ea0ab..79de7a2b52 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -86,6 +86,7 @@ MODULE FEAMooring_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Pointer to module variables [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LAnchxi !< Anchor coordinate [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LAnchyi !< Anchor coordinate [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LAnchzi !< Anchor coordinate [-] @@ -128,6 +129,7 @@ MODULE FEAMooring_Types ! ======================= ! ========= FEAM_MiscVarType ======= TYPE, PUBLIC :: FEAM_MiscVarType + TYPE(ModJacType) :: Jac !< Jacobian matrices and arrays corresponding to module variables [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: GLF !< Global forcing matrix [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: GLK !< Global stiffness matrix [-] REAL(ReKi) , DIMENSION(1:15,1:15) :: EMASS = 0.0_ReKi !< Line element mass [-] @@ -158,6 +160,7 @@ MODULE FEAMooring_Types TYPE, PUBLIC :: FEAM_ParameterType REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] REAL(ReKi) , DIMENSION(1:3) :: GRAV = 0.0_ReKi !< Gravity [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] REAL(ReKi) :: Eps = 0.0_ReKi !< Tolerance for static iteration [-] REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity [-] REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [-] @@ -223,7 +226,17 @@ MODULE FEAMooring_Types TYPE(MeshType) :: LineMeshPosition !< Meshed output data [-] END TYPE FEAM_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: FEAM_x_GLU = 1 ! FEAM%GLU + integer(IntKi), public, parameter :: FEAM_x_GLDU = 2 ! FEAM%GLDU + integer(IntKi), public, parameter :: FEAM_z_TSN = 3 ! FEAM%TSN + integer(IntKi), public, parameter :: FEAM_z_TZER = 4 ! FEAM%TZER + integer(IntKi), public, parameter :: FEAM_u_HydroForceLineMesh = 5 ! FEAM%HydroForceLineMesh + integer(IntKi), public, parameter :: FEAM_u_PtFairleadDisplacement = 6 ! FEAM%PtFairleadDisplacement + integer(IntKi), public, parameter :: FEAM_y_WriteOutput = 7 ! FEAM%WriteOutput + integer(IntKi), public, parameter :: FEAM_y_PtFairleadLoad = 8 ! FEAM%PtFairleadLoad + integer(IntKi), public, parameter :: FEAM_y_LineMeshPosition = 9 ! FEAM%LineMeshPosition + +contains subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) type(FEAM_InputFile), intent(in) :: SrcInputFileData @@ -758,6 +771,7 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + DstInitOutputData%Vars => SrcInitOutputData%Vars if (allocated(SrcInitOutputData%LAnchxi)) then LB(1:1) = lbound(SrcInitOutputData%LAnchxi) UB(1:1) = ubound(SrcInitOutputData%LAnchxi) @@ -849,6 +863,7 @@ subroutine FEAM_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitOutputData%Vars) if (allocated(InitOutputData%LAnchxi)) then deallocate(InitOutputData%LAnchxi) end if @@ -873,10 +888,18 @@ subroutine FEAM_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(FEAM_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackInitOutput' + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if call RegPackAlloc(RF, InData%LAnchxi) call RegPackAlloc(RF, InData%LAnchyi) call RegPackAlloc(RF, InData%LAnchzi) @@ -893,10 +916,30 @@ subroutine FEAM_UnPackInitOutput(RF, OutData) integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if call RegUnpackAlloc(RF, OutData%LAnchxi); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LAnchyi); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LAnchzi); if (RegCheckErr(RF, RoutineName)) return @@ -1223,9 +1266,13 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) character(*), intent( out) :: ErrMsg integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FEAM_CopyMisc' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%GLF)) then LB(1:2) = lbound(SrcMiscData%GLF) UB(1:2) = ubound(SrcMiscData%GLF) @@ -1366,9 +1413,13 @@ subroutine FEAM_DestroyMisc(MiscData, ErrStat, ErrMsg) type(FEAM_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FEAM_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%GLF)) then deallocate(MiscData%GLF) end if @@ -1406,6 +1457,7 @@ subroutine FEAM_PackMisc(RF, Indata) type(FEAM_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackMisc' if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackModJacType(RF, InData%Jac) call RegPackAlloc(RF, InData%GLF) call RegPackAlloc(RF, InData%GLK) call RegPack(RF, InData%EMASS) @@ -1441,6 +1493,7 @@ subroutine FEAM_UnPackMisc(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac call RegUnpackAlloc(RF, OutData%GLF); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%GLK); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%EMASS); if (RegCheckErr(RF, RoutineName)) return @@ -1482,6 +1535,18 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) ErrMsg = '' DstParamData%DT = SrcParamData%DT DstParamData%GRAV = SrcParamData%GRAV + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if DstParamData%Eps = SrcParamData%Eps DstParamData%Gravity = SrcParamData%Gravity DstParamData%WtrDens = SrcParamData%WtrDens @@ -1747,6 +1812,12 @@ subroutine FEAM_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FEAM_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if if (allocated(ParamData%NEQ)) then deallocate(ParamData%NEQ) end if @@ -1815,9 +1886,17 @@ subroutine FEAM_PackParam(RF, Indata) character(*), parameter :: RoutineName = 'FEAM_PackParam' integer(B4Ki) :: i1, i2, i3, i4 integer(B4Ki) :: LB(4), UB(4) + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%DT) call RegPack(RF, InData%GRAV) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if call RegPack(RF, InData%Eps) call RegPack(RF, InData%Gravity) call RegPack(RF, InData%WtrDens) @@ -1887,9 +1966,29 @@ subroutine FEAM_UnPackParam(RF, OutData) integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%GRAV); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if call RegUnpack(RF, OutData%Eps); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%WtrDens); if (RegCheckErr(RF, RoutineName)) return @@ -2410,5 +2509,317 @@ SUBROUTINE FEAM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL MeshExtrapInterp2(y1%LineMeshPosition, y2%LineMeshPosition, y3%LineMeshPosition, tin, y_out%LineMeshPosition, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE + +function FEAM_InputMeshPointer(u, DL) result(Mesh) + type(FEAM_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (FEAM_u_HydroForceLineMesh) + Mesh => u%HydroForceLineMesh + case (FEAM_u_PtFairleadDisplacement) + Mesh => u%PtFairleadDisplacement + end select +end function + +function FEAM_OutputMeshPointer(y, DL) result(Mesh) + type(FEAM_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (FEAM_y_PtFairleadLoad) + Mesh => y%PtFairleadLoad + case (FEAM_y_LineMeshPosition) + Mesh => y%LineMeshPosition + end select +end function + +subroutine FEAM_VarsPackContState(Vars, x, ValAry) + type(FEAM_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call FEAM_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine FEAM_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(FEAM_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FEAM_x_GLU) + VarVals = x%GLU(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (FEAM_x_GLDU) + VarVals = x%GLDU(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FEAM_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FEAM_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call FEAM_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine FEAM_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FEAM_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FEAM_x_GLU) + x%GLU(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (FEAM_x_GLDU) + x%GLDU(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + +function FEAM_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FEAM_x_GLU) + Name = "x%GLU" + case (FEAM_x_GLDU) + Name = "x%GLDU" + case default + Name = "Unknown Field" + end select +end function + +subroutine FEAM_VarsPackContStateDeriv(Vars, x, ValAry) + type(FEAM_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call FEAM_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine FEAM_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(FEAM_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FEAM_x_GLU) + VarVals = x%GLU(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (FEAM_x_GLDU) + VarVals = x%GLDU(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FEAM_VarsPackConstrState(Vars, z, ValAry) + type(FEAM_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call FEAM_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine FEAM_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(FEAM_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FEAM_z_TSN) + VarVals = z%TSN(V%iLB:V%iUB) ! Rank 1 Array + case (FEAM_z_TZER) + VarVals = z%TZER(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FEAM_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FEAM_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call FEAM_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine FEAM_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FEAM_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FEAM_z_TSN) + z%TSN(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (FEAM_z_TZER) + z%TZER(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function FEAM_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FEAM_z_TSN) + Name = "z%TSN" + case (FEAM_z_TZER) + Name = "z%TZER" + case default + Name = "Unknown Field" + end select +end function + +subroutine FEAM_VarsPackInput(Vars, u, ValAry) + type(FEAM_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call FEAM_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine FEAM_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(FEAM_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FEAM_u_HydroForceLineMesh) + call MV_PackMesh(V, u%HydroForceLineMesh, ValAry) ! Mesh + case (FEAM_u_PtFairleadDisplacement) + call MV_PackMesh(V, u%PtFairleadDisplacement, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FEAM_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FEAM_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call FEAM_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine FEAM_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FEAM_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FEAM_u_HydroForceLineMesh) + call MV_UnpackMesh(V, ValAry, u%HydroForceLineMesh) ! Mesh + case (FEAM_u_PtFairleadDisplacement) + call MV_UnpackMesh(V, ValAry, u%PtFairleadDisplacement) ! Mesh + end select + end associate +end subroutine + +function FEAM_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FEAM_u_HydroForceLineMesh) + Name = "u%HydroForceLineMesh" + case (FEAM_u_PtFairleadDisplacement) + Name = "u%PtFairleadDisplacement" + case default + Name = "Unknown Field" + end select +end function + +subroutine FEAM_VarsPackOutput(Vars, y, ValAry) + type(FEAM_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call FEAM_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine FEAM_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(FEAM_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FEAM_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case (FEAM_y_PtFairleadLoad) + call MV_PackMesh(V, y%PtFairleadLoad, ValAry) ! Mesh + case (FEAM_y_LineMeshPosition) + call MV_PackMesh(V, y%LineMeshPosition, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine FEAM_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(FEAM_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call FEAM_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine FEAM_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(FEAM_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (FEAM_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (FEAM_y_PtFairleadLoad) + call MV_UnpackMesh(V, ValAry, y%PtFairleadLoad) ! Mesh + case (FEAM_y_LineMeshPosition) + call MV_UnpackMesh(V, ValAry, y%LineMeshPosition) ! Mesh + end select + end associate +end subroutine + +function FEAM_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (FEAM_y_WriteOutput) + Name = "y%WriteOutput" + case (FEAM_y_PtFairleadLoad) + Name = "y%PtFairleadLoad" + case (FEAM_y_LineMeshPosition) + Name = "y%LineMeshPosition" + case default + Name = "Unknown Field" + end select +end function + END MODULE FEAMooring_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/Conv_Radiation.f90 b/modules/hydrodyn/src/Conv_Radiation.f90 index 59842ddd2c..7bfa90c169 100644 --- a/modules/hydrodyn/src/Conv_Radiation.f90 +++ b/modules/hydrodyn/src/Conv_Radiation.f90 @@ -164,14 +164,14 @@ SUBROUTINE Conv_Rdtn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, InitOut, E RETURN END IF - ALLOCATE ( p%RdtnKrnl (0:p%NStepRdtn-1,6*p%NBody,6*p%NBody) , STAT=ErrStat ) + ALLOCATE ( p%RdtnKrnl (6*p%NBody,6*p%NBody,0:p%NStepRdtn-1) , STAT=ErrStat ) IF ( ErrStat /= ErrID_None ) THEN ErrMsg = ' Error allocating memory for the RdtnKrnl array.' ErrStat = ErrID_Fatal RETURN END IF - ALLOCATE ( xd%XDHistory(0:p%NStepRdtn ,6*p%NBody ) , STAT=ErrStat ) ! In the numerical convolution we must have NStepRdtn1 elements within the XDHistory array, which is one more than the NStepRdtn elements that are in the RdtnKrnl array + ALLOCATE ( xd%XDHistory(6*p%NBody,0:p%NStepRdtn) , STAT=ErrStat ) ! In the numerical convolution we must have NStepRdtn1 elements within the XDHistory array, which is one more than the NStepRdtn elements that are in the RdtnKrnl array IF ( ErrStat /= ErrID_None ) THEN ErrMsg = ' Error allocating memory for the XDHistory array.' ErrStat = ErrID_Fatal @@ -181,7 +181,7 @@ SUBROUTINE Conv_Rdtn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, InitOut, E ! Initialize all elements of the xd%XDHistory array with the intial values of u%Velocity DO K = 0,p%NStepRdtn-1 DO J = 1,6*p%NBody ! Loop through all DOFs - xd%XDHistory(K,J) = u%Velocity(J) + xd%XDHistory(J,K) = u%Velocity(J) END DO END DO @@ -221,7 +221,7 @@ SUBROUTINE Conv_Rdtn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, InitOut, E DO J = 1,6*p%NBody ! Loop through all rows of RdtnKrnl DO K = 1,6*p%NBody ! Loop through all columns of RdtnKrnl above and including the diagonal !Indx = Indx + 1 - p%RdtnKrnl(I,J,K) = Krnl_Fact*Omega*( InterpStp( Omega, InitInp%HdroFreq(:), & + p%RdtnKrnl(J,K,I) = Krnl_Fact*Omega*( InterpStp( Omega, InitInp%HdroFreq(:), & InitInp%HdroAddMs(: ,J,K), LastInd, InitInp%NInpFreq ) & - InitInp%HdroAddMs(InitInp%NInpFreq,J,K) ) END DO ! K - All columns of RdtnKrnl above and including the diagonal @@ -245,7 +245,7 @@ SUBROUTINE Conv_Rdtn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, InitOut, E DO J = 1,6*p%NBody ! Loop through all rows of RdtnKrnl DO K = 1,6*p%NBody ! Loop through all columns of RdtnKrnl above and including the diagonal - CALL ApplySINT( p%RdtnKrnl(:,J,K), FFT_Data, ErrStat ) + CALL ApplySINT( p%RdtnKrnl(J,K,:), FFT_Data, ErrStat ) IF ( ErrStat /= ErrID_None ) RETURN END DO ! K - All columns of RdtnKrnl above and including the diagonal END DO ! J - All rows of RdtnKrnl @@ -293,7 +293,7 @@ SUBROUTINE Conv_Rdtn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, InitOut, E DO J = 1,6*p%NBody ! Loop through all rows of RdtnKrnl DO K = 1,6*p%NBody ! Loop through all columns of RdtnKrnl above and including the diagonal !Indx = Indx + 1 - p%RdtnKrnl(I,J,K) = Krnl_Fact*InterpStp ( Omega, InitInp%HdroFreq(:), InitInp%HdroDmpng(:,J,K), LastInd, InitInp%NInpFreq ) + p%RdtnKrnl(J,K,I) = Krnl_Fact*InterpStp ( Omega, InitInp%HdroFreq(:), InitInp%HdroDmpng(:,J,K), LastInd, InitInp%NInpFreq ) END DO ! K - All columns of RdtnKrnl above and including the diagonal END DO ! J - All rows of RdtnKrnl @@ -314,7 +314,7 @@ SUBROUTINE Conv_Rdtn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, InitOut, E DO J = 1,6*p%NBody ! Loop through all rows of RdtnKrnl DO K = 1,6*p%NBody ! Loop through all columns of RdtnKrnl above and including the diagonal - CALL ApplyCOST( p%RdtnKrnl(:,J,K), FFT_Data, ErrStat ) + CALL ApplyCOST( p%RdtnKrnl(J,K,:), FFT_Data, ErrStat ) IF ( ErrStat /= ErrID_None ) THEN ErrMsg = 'Error applying Cosine Transform' ErrStat = ErrID_Fatal @@ -481,6 +481,7 @@ END SUBROUTINE Conv_Rdtn_UpdateStates !> Routine for computing outputs, used in both loose and tight coupling. SUBROUTINE Conv_Rdtn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) !.................................................................................................................................. + use NWTC_LAPACK, only: LAPACK_gemm REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds TYPE(Conv_Rdtn_InputType), INTENT(IN ) :: u !< Inputs at Time @@ -495,52 +496,60 @@ SUBROUTINE Conv_Rdtn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None -! REAL(ReKi) :: F_Rdtn (6) - REAL(ReKi) :: F_RdtnDT (6*p%NBody) ! The portion of the total load contribution from wave radiation damping associated with the convolution integral proportional to ( RdtnDT - RdtnRmndr ) (N, N-m) + character(*), parameter :: RoutineName = 'Conv_Rdtn_CalcOutput' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + REAL(SiKi), allocatable :: F_RdtnDT(:,:) ! The portion of the total load contribution from wave radiation damping associated with the convolution integral proportional to ( RdtnDT - RdtnRmndr ) (N, N-m) INTEGER :: I ! Generic index INTEGER :: J ! Generic index INTEGER :: K ! Generic index INTEGER(IntKi) :: MaxInd - ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" - - ! Perform numerical convolution to determine the load contribution from wave - ! radiation damping: - MaxInd = MIN(p%NStepRdtn-1,OtherState%IndRdtn) ! Note: xd%IndRdtn index is from the previous time-step since this state was for the previous time-step - DO I = 1,6*p%NBody ! Loop through all wave radiation damping forces and moments - - F_RdtnDT (I) = 0.0 - ! F_RdtnRmndr(I) = 0.0 - - DO J = 1,6*p%NBody ! Loop through all platform DOFs - ! Contribution from the first and last time steps are halved to make the integration 2nd-order accurate - F_RdtnDT(I) = F_RdtnDT(I) - 0.5_SiKi * p%RdtnKrnl(MaxInd,I,J)*xd%XDHistory(0,J) & - - 0.5_SiKi * p%RdtnKrnl(0,I,J)*xd%XDHistory(MaxInd,J) - DO K = 1, MaxInd-1 ! Loop through all remaining NStepRdtn-2 time steps in the radiation Kernel (less than NStepRdtn time steps are used when ZTime < RdtnTmax) - F_RdtnDT(I) = F_RdtnDT(I) - p%RdtnKrnl(MaxInd-K,I,J)*xd%XDHistory(K,J) - END DO - !DO K = MAX(0,xd%IndRdtn-p%NStepRdtn ),xd%IndRdtn-1 ! Loop through all NStepRdtn time steps in the radiation Kernel (less than NStepRdtn time steps are used when ZTime < RdtnTmax) - ! F_RdtnDT (I) = F_RdtnDT (I) - p%RdtnKrnl(xd%IndRdtn-1-K,I,J)*xd%XDHistory(MOD(K,p%NStepRdtn1),J) - !END DO ! K - All NStepRdtn time steps in the radiation Kernel (less than NStepRdtn time steps are used when ZTime < RdtnTmax) - - !DO K = MAX(0,xd%IndRdtn-p%NStepRdtn+1),xd%IndRdtn ! Loop through all NStepRdtn time steps in the radiation Kernel (less than NStepRdtn time steps are used when ZTime < RdtnTmax) - ! F_RdtnRmndr(I) = F_RdtnRmndr(I) - p%RdtnKrnl(xd%IndRdtn -K,I,J)*xd%XDHistory(MOD(K,p%NStepRdtn1),J) - !END DO ! K - All NStepRdtn time steps in the radiation Kernel (less than NStepRdtn time steps are used when ZTime < RdtnTmax) - - END DO ! J - All platform DOFs - - !F_Rdtn (I) = ( p%RdtnDT - xd%RdtnRmndr )*F_RdtnDT(I) + xd%RdtnRmndr*F_RdtnRmndr(I) - - END DO ! I - All wave radiation damping forces and moments - - y%F_Rdtn = p%RdtnDT*F_RdtnDT !F_Rdtn + call AllocAry(F_RdtnDT, 6*p%NBody, 1, 'F_RdtnDT', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + ! Perform numerical convolution to determine the load contribution from wave radiation damping: + ! Contribution from the first and last time steps are halved to make the integration 2nd-order accurate + + ! First time step + call LAPACK_gemm('N', 'N', -0.5_SiKi, p%RdtnKrnl(:,:,MaxInd), xd%XDHistory(:,0:0), 0.0_SiKi, F_RdtnDT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + ! Last time step + call LAPACK_gemm('N', 'N', -0.5_SiKi, p%RdtnKrnl(:,:,0), xd%XDHistory(:,MaxInd:MaxInd), 1.0_SiKi, F_RdtnDT, ErrStat2, ErrMsg2) + + ! Intermediate time steps + do K = 1, MaxInd-1 + call LAPACK_gemm('N', 'N', -1.0_SiKi, p%RdtnKrnl(:,:,MaxInd-K), xd%XDHistory(:,K:K), 1.0_SiKi, F_RdtnDT, ErrStat2, ErrMsg2) + end do + + y%F_Rdtn = p%RdtnDT*real(F_RdtnDT(:,1), ReKi) !F_Rdtn + + ! Loop through all wave radiation damping forces and moments + ! F_RdtnDT = 0.0 + ! DO I = 1, 6*p%NBody + ! DO J = 1,6*p%NBody ! Loop through all platform DOFs + ! ! Contribution from the first and last time steps are halved to make the integration 2nd-order accurate + ! F_RdtnDT(I) = F_RdtnDT(I) - 0.5_SiKi * p%RdtnKrnl(MaxInd,I,J)*xd%XDHistory(0,J) & + ! - 0.5_SiKi * p%RdtnKrnl(0,I,J)*xd%XDHistory(MaxInd,J) + + ! ! Loop through all remaining NStepRdtn-2 time steps in the radiation Kernel (less than NStepRdtn time steps are used when ZTime < RdtnTmax) + ! DO K = 1, MaxInd-1 + ! F_RdtnDT(I) = F_RdtnDT(I) - p%RdtnKrnl(MaxInd-K,I,J)*xd%XDHistory(K,J) + ! END DO + ! END DO ! J - All platform DOFs + ! END DO ! I - All wave radiation damping forces and moments + + ! y%F_Rdtn = p%RdtnDT*F_RdtnDT !F_Rdtn END SUBROUTINE Conv_Rdtn_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- @@ -635,18 +644,18 @@ SUBROUTINE Conv_Rdtn_UpdateDiscState( Time, n, u, p, x, xd, z, OtherState, m, Er IF ( OtherState%IndRdtn < (p%NStepRdtn) ) THEN DO J = 1,6*p%NBody ! Loop through all platform DOFs - xd%XDHistory(OtherState%IndRdtn,J) = u%Velocity(J) ! XDHistory was allocated as a zero-based array! + xd%XDHistory(J,OtherState%IndRdtn) = u%Velocity(J) ! XDHistory was allocated as a zero-based array! END DO ! J - All platform DOFs ELSE ! Shift the stored history by one index DO K = 0,p%NStepRdtn-2 DO J = 1,6*p%NBody ! Loop through all DOFs - xd%XDHistory(K,J) = xd%XDHistory(K+1,J) + xd%XDHistory(J,K) = xd%XDHistory(J,K+1) END DO END DO DO J = 1,6*p%NBody ! Loop through all platform DOFs - xd%XDHistory(p%NStepRdtn-1,J) = u%Velocity(J) ! Set the last array element to the current velocity + xd%XDHistory(J,p%NStepRdtn-1) = u%Velocity(J) ! Set the last array element to the current velocity END DO ! J - All platform DOFs END IF diff --git a/modules/hydrodyn/src/Conv_Radiation.txt b/modules/hydrodyn/src/Conv_Radiation.txt index 711c028559..9836df2acf 100644 --- a/modules/hydrodyn/src/Conv_Radiation.txt +++ b/modules/hydrodyn/src/Conv_Radiation.txt @@ -43,7 +43,7 @@ typedef ^ ContinuousStateType SiKi # # Define discrete (nondifferentiable) states here: # -typedef ^ DiscreteStateType ReKi XDHistory {:}{:} - - "" - +typedef ^ DiscreteStateType SiKi XDHistory {:}{:} - - "" - typedef ^ ^ DbKi LastTime - - - "" - # # diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index 4104c950b5..b10a6b7183 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -59,7 +59,7 @@ MODULE Conv_Radiation_Types ! ======================= ! ========= Conv_Rdtn_DiscreteStateType ======= TYPE, PUBLIC :: Conv_Rdtn_DiscreteStateType - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: XDHistory !< [-] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: XDHistory !< [-] REAL(DbKi) :: LastTime = 0.0_R8Ki !< [-] END TYPE Conv_Rdtn_DiscreteStateType ! ======================= @@ -98,7 +98,12 @@ MODULE Conv_Radiation_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_Rdtn !< [-] END TYPE Conv_Rdtn_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: Conv_Rdtn_x_DummyContState = 1 ! Conv_Rdtn%DummyContState + integer(IntKi), public, parameter :: Conv_Rdtn_z_DummyConstrState = 2 ! Conv_Rdtn%DummyConstrState + integer(IntKi), public, parameter :: Conv_Rdtn_u_Velocity = 3 ! Conv_Rdtn%Velocity + integer(IntKi), public, parameter :: Conv_Rdtn_y_F_Rdtn = 4 ! Conv_Rdtn%F_Rdtn + +contains subroutine Conv_Rdtn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(Conv_Rdtn_InitInputType), intent(in) :: SrcInitInputData @@ -971,5 +976,277 @@ SUBROUTINE Conv_Rdtn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSt y_out%F_Rdtn = a1*y1%F_Rdtn + a2*y2%F_Rdtn + a3*y3%F_Rdtn END IF ! check if allocated END SUBROUTINE + +function Conv_Rdtn_InputMeshPointer(u, DL) result(Mesh) + type(Conv_Rdtn_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +function Conv_Rdtn_OutputMeshPointer(y, DL) result(Mesh) + type(Conv_Rdtn_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +subroutine Conv_Rdtn_VarsPackContState(Vars, x, ValAry) + type(Conv_Rdtn_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call Conv_Rdtn_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine Conv_Rdtn_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(Conv_Rdtn_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Conv_Rdtn_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Conv_Rdtn_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Conv_Rdtn_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call Conv_Rdtn_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine Conv_Rdtn_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Conv_Rdtn_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Conv_Rdtn_x_DummyContState) + x%DummyContState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function Conv_Rdtn_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Conv_Rdtn_x_DummyContState) + Name = "x%DummyContState" + case default + Name = "Unknown Field" + end select +end function + +subroutine Conv_Rdtn_VarsPackContStateDeriv(Vars, x, ValAry) + type(Conv_Rdtn_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call Conv_Rdtn_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine Conv_Rdtn_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(Conv_Rdtn_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Conv_Rdtn_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Conv_Rdtn_VarsPackConstrState(Vars, z, ValAry) + type(Conv_Rdtn_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call Conv_Rdtn_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine Conv_Rdtn_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(Conv_Rdtn_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Conv_Rdtn_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Conv_Rdtn_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Conv_Rdtn_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call Conv_Rdtn_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine Conv_Rdtn_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Conv_Rdtn_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Conv_Rdtn_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function Conv_Rdtn_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Conv_Rdtn_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine Conv_Rdtn_VarsPackInput(Vars, u, ValAry) + type(Conv_Rdtn_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call Conv_Rdtn_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine Conv_Rdtn_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(Conv_Rdtn_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Conv_Rdtn_u_Velocity) + VarVals = u%Velocity(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Conv_Rdtn_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Conv_Rdtn_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call Conv_Rdtn_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine Conv_Rdtn_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Conv_Rdtn_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Conv_Rdtn_u_Velocity) + u%Velocity(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function Conv_Rdtn_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Conv_Rdtn_u_Velocity) + Name = "u%Velocity" + case default + Name = "Unknown Field" + end select +end function + +subroutine Conv_Rdtn_VarsPackOutput(Vars, y, ValAry) + type(Conv_Rdtn_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call Conv_Rdtn_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine Conv_Rdtn_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(Conv_Rdtn_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Conv_Rdtn_y_F_Rdtn) + VarVals = y%F_Rdtn(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Conv_Rdtn_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Conv_Rdtn_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call Conv_Rdtn_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine Conv_Rdtn_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Conv_Rdtn_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Conv_Rdtn_y_F_Rdtn) + y%F_Rdtn(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function Conv_Rdtn_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Conv_Rdtn_y_F_Rdtn) + Name = "y%F_Rdtn" + case default + Name = "Unknown Field" + end select +end function + END MODULE Conv_Radiation_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index eb668763be..36c5a152f6 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -73,8 +73,8 @@ MODULE HydroDyn PUBLIC :: HD_JacobianPConstrState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - ! (Xd), and constraint - state(Z) functions all with respect to the constraint ! states(z) - PUBLIC :: HD_GetOP !< Routine to pack the operating point values (for linearization) into arrays - + PUBLIC :: HD_PackExtInputAry ! Pack extended inputs + CONTAINS !---------------------------------------------------------------------------------------------------------------------------------- @@ -623,7 +623,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I WRITE( InputFileData%UnSum, '(1X,I10,2X,E12.5)',ADVANCE='no' ) K, K*p%WAMIT(1)%Conv_Rdtn%RdtnDT do i = 1,6*p%NBody do j = 1,6*p%NBody - WRITE( InputFileData%UnSum, '(2X,ES16.5)',ADVANCE='no' ) p%WAMIT(1)%Conv_Rdtn%RdtnKrnl(k,i,j) + WRITE( InputFileData%UnSum, '(2X,ES16.5)',ADVANCE='no' ) p%WAMIT(1)%Conv_Rdtn%RdtnKrnl(i,j,k) end do end do write(InputFileData%UnSum,'()') ! end of line character @@ -640,13 +640,13 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Write the data DO I = 0,p%WAMIT(j)%Conv_Rdtn%NStepRdtn-1 WRITE( InputFileData%UnSum, '(1X,I10,2X,E12.5,21(2X,ES16.5))' ) I, I*p%WAMIT(j)%Conv_Rdtn%RdtnDT, & - p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,1,1), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,1,2), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,1,3), & - p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,1,4), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,1,5), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,1,6), & - p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,2,2), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,2,3), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,2,4), & - p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,2,5), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,2,6), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,3,3), & - p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,3,4), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,3,5), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,3,6), & - p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,4,4), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,4,5), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,4,6), & - p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,5,5), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,5,6), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(I,6,6) + p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(1,1,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(1,2,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(1,3,I), & + p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(1,4,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(1,5,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(1,6,I), & + p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(2,2,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(2,3,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(2,4,I), & + p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(2,5,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(2,6,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(3,3,I), & + p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(3,4,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(3,5,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(3,6,I), & + p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(4,4,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(4,5,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(4,6,I), & + p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(5,5,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(5,6,I), p%WAMIT(j)%Conv_Rdtn%RdtnKrnl(6,6,I) END DO end do end if @@ -838,13 +838,20 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I InitOut%Ver = HydroDyn_ProgDesc + !............................................................................................ + ! Module Variables: + !............................................................................................ + + call HydroDyn_InitVars(InitOut%Vars, u, p, x, y, m, InitOut, InputFileData, InitInp%Linearize, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + !............................................................................................ ! Initialize Jacobian: !............................................................................................ - if (InitInp%Linearize) then - call HD_Init_Jacobian( p, u, y, InitOut, ErrStat2, ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if + ! if (InitInp%Linearize) then + ! call HD_Init_Jacobian( p, u, y, InitOut, ErrStat2, ErrMsg2) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! end if IF ( p%OutSwtch == 1 ) THEN ! Only HD-level output writing ! HACK WE can tell FAST not to write any HD outputs by simply deallocating the WriteOutputHdr array! @@ -933,6 +940,147 @@ SUBROUTINE HydroDyn_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) END SUBROUTINE HydroDyn_End +subroutine HydroDyn_InitVars(Vars, u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat, ErrMsg) + type(ModVarsType), intent(out) :: Vars !< Module variables + type(HydroDyn_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(HydroDyn_ParameterType), intent(inout) :: p !< Parameters + type(HydroDyn_ContinuousStateType), intent(inout) :: x !< Continuous state + type(HydroDyn_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(HydroDyn_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(HydroDyn_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + type(HydroDyn_InputFile), intent(in) :: InputFileData !< Input file data + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'HydroDyn_InitVars' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + integer(IntKi) :: i, j, k + real(R8Ki) :: PerturbTrans, PerturbRot, Perturbs(6) + character(10) :: BodyDesc + character(10), parameter :: dofLabels(6) = & + ['PtfmSg', 'PtfmSw', 'PtfmHv', 'PtfmR ', 'PtfmP ', 'PtfmY '] + + ErrStat = ErrID_None + ErrMsg = "" + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + ! Need to determine how many wamit body objects there are + p%totalExctnStates = 0 + p%totalRdtnStates = 0 + do j = 1, p%nWAMITObj + p%totalExctnStates = p%totalExctnStates + p%WAMIT(j)%SS_Exctn%numStates ! numStates defaults to zero in the case where ExctnMod = 0 instead of 2 + p%totalRdtnStates = p%totalRdtnStates + p%WAMIT(j)%SS_Rdtn%numStates ! numStates defaults to zero in the case where RdtnMod = 0 instead of 2 + end do + p%totalStates = p%totalExctnStates + p%totalRdtnStates + + ! Initialize body description to empty + BodyDesc = "" + + ! Get excitation + do k = 1, p%nWAMITObj + if (p%WAMIT(k)%SS_Exctn%numStates == 0) cycle + if (p%NBody > 1) BodyDesc = 'B'//trim(Num2LStr(k)) + call MV_AddVar(Vars%x, "WAMIT("//trim(Num2LStr(k))//")%SS_Exctn", FieldScalar, & + DatLoc(HydroDyn_x_WAMIT_SS_Exctn_x, k), & + Flags=VF_DerivOrder1, & + Num=p%WAMIT(k)%SS_Exctn%numStates, & + Perturb=20000.0_R8Ki * D2R_D, & + LinNames=[((trim(BodyDesc)//'Exctn'//trim(dofLabels(j))//Num2LStr(i), i = 1, p%WAMIT(k)%SS_Exctn%spDOF(j)), j = 1, 6)]) + end do + + do k = 1, p%nWAMITObj + if (p%WAMIT(k)%SS_Rdtn%numStates == 0) cycle + if (p%NBody > 1) BodyDesc = 'B'//trim(Num2LStr(k)) + call MV_AddVar(Vars%x, "WAMIT("//trim(Num2LStr(k))//")%SS_Rdtn", FieldScalar, & + DatLoc(HydroDyn_x_WAMIT_SS_Rdtn_x, k), & + Flags=VF_DerivOrder1, & + Num=p%WAMIT(k)%SS_Rdtn%numStates, & + Perturb=2.0_R8Ki * D2R_D , & + LinNames=[((trim(BodyDesc)//'Rdtn'//trim(dofLabels(j))//Num2LStr(i), i = 1, p%WAMIT(k)%SS_Rdtn%spDOF(j)), j = 1, 6)]) + end do + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + ! Translation and rotation perturbations + PerturbTrans = 0.02_R8Ki*D2R * max(real(p%WaveField%EffWtrDpth, R8Ki), 1.0_R8Ki) + PerturbRot = 2*D2R + + ! Create perturbation array (order based on MotionFields) + Perturbs = [PerturbTrans, & ! FieldTransDisp + PerturbRot, & ! FieldOrientation + PerturbTrans, & ! FieldTransVel + PerturbRot, & ! FieldAngularVel + PerturbTrans, & ! FieldTransAcc + PerturbRot] ! FieldAngularAcc + + call MV_AddMeshVar(Vars%u, "Morison", MotionFields, DatLoc(HydroDyn_u_Morison_Mesh), u%Morison%Mesh, & + Perturbs=Perturbs) + + call MV_AddMeshVar(Vars%u, "WAMIT", MotionFields, DatLoc(HydroDyn_u_WAMITMesh), u%WAMITMesh, & + Perturbs=Perturbs) + + call MV_AddMeshVar(Vars%u, "Platform-RefPt", MotionFields, DatLoc(HydroDyn_u_PRPMesh), u%PRPMesh, & + Perturbs=Perturbs) + + call MV_AddVar(Vars%u, "WaveElev0", FieldScalar, DatLoc(HydroDyn_u_WaveElev0), & + Flags=VF_ExtLin + VF_Linearize, & + LinNames=['Extended input: wave elevation at platform ref point, m']) + + call MV_AddVar(Vars%u, "HWindSpeed", FieldScalar, DatLoc(HydroDyn_u_HWindSpeed), & + Flags=VF_ExtLin + VF_Linearize, & + LinNames=['Extended input: horizontal current speed (steady/uniform wind), m/s']) + + call MV_AddVar(Vars%u, "PLexp", FieldScalar, DatLoc(HydroDyn_u_PLexp), & + Flags=VF_ExtLin + VF_Linearize, & + LinNames=['Extended input: vertical power-law shear exponent, -']) + + call MV_AddVar(Vars%u, "PropagationDir", FieldScalar, DatLoc(HydroDyn_u_PropagationDir), & + Flags=VF_ExtLin + VF_Linearize, & + LinNames=['Extended input: propagation direction, rad']) + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + call MV_AddMeshVar(Vars%y, "MorisonLoads", LoadFields, DatLoc(HydroDyn_y_Morison_Mesh), y%Morison%Mesh) + + call MV_AddMeshVar(Vars%y, "WAMITLoads", LoadFields, DatLoc(HydroDyn_y_WAMITMesh), y%WAMITMesh) + + call MV_AddVar(Vars%y, "WriteOutput", FieldScalar, DatLoc(HydroDyn_y_WriteOutput), & + Flags=VF_WriteOut, & + Num=p%NumTotalOuts, & + LinNames=[(WriteOutputLinName(i), i = 1, p%NumTotalOuts)]) + + !---------------------------------------------------------------------------- + ! Initialize Variables and Jacobian data + !---------------------------------------------------------------------------- + + call MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + call HydroDyn_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call HydroDyn_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call HydroDyn_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call HydroDyn_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + +contains + character(LinChanLen) function WriteOutputLinName(idx) + integer(IntKi), intent(in) :: idx + WriteOutputLinName = trim(InitOut%WriteOutputHdr(idx))//', '//trim(InitOut%WriteOutputUnt(idx)) + end function + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- !> Loose coupling routine for solving constraint states, integrating continuous states, and updating discrete states. @@ -1602,21 +1750,22 @@ end function CalcLoadsAtWRP !---------------------------------------------------------------------------------------------------------------------------------- !> 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 HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu ) +SUBROUTINE HD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) !.................................................................................................................................. + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(HydroDyn_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(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + TYPE(HydroDyn_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 @@ -1628,127 +1777,95 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM 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] + CHARACTER(*), PARAMETER :: RoutineName = 'HD_JacobianPInput' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + INTEGER(IntKi) :: i, j, k, col + INTEGER(IntKi) :: startingI, startingJ, bOffset, offsetI + integer(IntKi) :: iVarWaveElev0, iVarHWindSpeed, iVarPLexp, iVarPropagationDir - ! local variables - TYPE(HydroDyn_OutputType) :: y_p - TYPE(HydroDyn_OutputType) :: y_m - TYPE(HydroDyn_ContinuousStateType) :: x_p - TYPE(HydroDyn_ContinuousStateType) :: x_m - TYPE(HydroDyn_InputType) :: u_perturb - REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, j, k, startingI, startingJ, bOffset, offsetI, n_du_extend, n_du_norm - integer(IntKi), parameter :: nu_extended = 4 ! 4 total extended inputs: WaveElev0 from SeaSt, HWindSpeed / PLexp / PropagationDir from IfW (turbulent sea current) - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HD_JacobianPInput' - - - ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' + + ! Get extended input variable indices + iVarWaveElev0 = 0 + iVarHWindSpeed = 0 + iVarPLexp = 0 + iVarPropagationDir = 0 + do i = 1, size(Vars%u) + select case (Vars%u(i)%DL%Num) + case (HydroDyn_u_WaveElev0) + iVarWaveElev0 = i + case (HydroDyn_u_HWindSpeed) + iVarHWindSpeed = i + case (HydroDyn_u_PLexp) + iVarPLexp = i + case (HydroDyn_u_PropagationDir) + iVarPropagationDir = i + end select + end do - n_du_norm = size(p%Jac_u_indx,1) - n_du_extend = n_du_norm + nu_extended - - ! make a copy of the inputs to perturb - call HydroDyn_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - + ! make a copy of the inputs to perturb + call HydroDyn_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + ! Pack inputs into array + call HydroDyn_VarsPackInput(Vars, u, m%Jac%u); if (Failed()) return - IF ( PRESENT( dYdu ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + if (present(dYdu)) then ! allocate dYdu if necessary if (.not. allocated(dYdu)) then - call AllocAry(dYdu, p%Jac_ny, n_du_extend, 'dYdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dYdu, m%Jac%Ny, m%Jac%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call HydroDyn_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call HydroDyn_CopyOutput( y, y_m, 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) ! NOTE: extended inputs are not included in p%Jac_u_indx - - ! get u_op + delta u - call HydroDyn_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 - call HD_Perturb_u( p, i, 1, u_perturb, delta ) - - ! compute y at u_op + delta u - call HydroDyn_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, 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 u - call HydroDyn_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 - call HD_Perturb_u( p, i, -1, u_perturb, delta ) - - ! compute y at u_op - delta u - call HydroDyn_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, 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, dYdu(:,i) ) - - end do - + ! Loop through input variables + do i = 1, size(Vars%u) - !------------------- - ! extended inputs - ! WaveElev0 column -- from SeaState - dYdu(:,n_du_norm+1) = 0.0_ReKi + ! If variable is extended input, skip + if (MV_HasFlagsAll(Vars%u(i), VF_ExtLin)) cycle - ! HWindSpeed / PLexp / PropagationDir -- from Ifw/FlowField for turbulent sea current - dYdu(:,n_du_norm+2:n_du_norm+4) = 0.0_ReKi - + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%u(i)%Num - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - call HydroDyn_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call HydroDyn_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - + ! Calculate positive perturbation + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call HydroDyn_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call HydroDyn_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call HydroDyn_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call HydroDyn_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call HydroDyn_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call HydroDyn_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) + + ! Calculate column index + col = Vars%u(i)%iLoc(1) + j - 1 + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(Vars%y, Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) + end do + end do + + ! Set extended inputs + if (iVarWaveElev0 > 0) dYdu(:, Vars%u(iVarWaveElev0)%iLoc(1)) = 0.0_R8Ki + if (iVarHWindSpeed > 0) dYdu(:, Vars%u(iVarHWindSpeed)%iLoc(1)) = 0.0_R8Ki + if (iVarPLexp > 0) dYdu(:, Vars%u(iVarPLexp)%iLoc(1)) = 0.0_R8Ki + if (iVarPropagationDir > 0) dYdu(:, Vars%u(iVarPropagationDir)%iLoc(1)) = 0.0_R8Ki + END IF - + ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: IF ( PRESENT( dXdu ) ) THEN ! For the case where either RdtnMod=0 and ExtcnMod=0 and hence %SS_Rdtn data or %SS_Exctn data is not valid then we do not have states, so simply return ! The key here is to never allocate the dXdu and related state Jacobian arrays because then the glue-code will behave properly - ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: - ! allocate dXdu if necessary if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%totalStates, n_du_extend, 'dXdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dXdu, m%Jac%Nx, m%Jac%Nu, 'dXdu', ErrStat2, ErrMsg2) + if (Failed()) return end if offsetI = 0 @@ -1756,13 +1873,13 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM do j = 1,p%nWAMITObj do i = 1,p%WAMIT(j)%SS_Exctn%numStates - dXdu(offsetI+i,n_du_extend) = p%WAMIT(j)%SS_Exctn%B(i) ! B is numStates by 1 + dXdu(offsetI+i,m%Jac%Nu) = p%WAMIT(j)%SS_Exctn%B(i) ! B is numStates by 1 end do offsetI = offsetI + p%WAMIT(j)%SS_Exctn%numStates end do startingI = p%totalStates - p%totalRdtnStates - startingJ = n_du_norm - 18 - 4*3*p%NBody ! subtract 6*3 for PRPMesh and then 4*3*NBody to place us at the beginning of the velocity inputs + startingJ = m%Jac%Nu - 4 - 18 - 4*3*p%NBody ! subtract 4 for extended inputs and 4*3*NBody to place us at the beginning of the velocity inputs ! B is numStates by 6*NBody where NBody =1 if NBodyMod=2 or 3, but could be >1 for NBodyMod=1 if ( p%NBodyMod == 1 ) then ! Example for NBodyMod=1 and NBody = 2, @@ -1813,7 +1930,6 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! dXdu(:,startingIndx +11) = p%WAMIT(2)%SS_Rdtn%B(:,5) ! dXdu(:,startingIndx +12) = p%WAMIT(2)%SS_Rdtn%B(:,6) - k=0 offsetI=0 ! First set all translationalVel components @@ -1841,8 +1957,6 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM END IF - - IF ( PRESENT( dXddu ) ) THEN if (allocated(dXddu)) deallocate(dXddu) END IF @@ -1851,36 +1965,29 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM if (allocated(dZdu)) deallocate(dZdu) END IF - call cleanup() - contains - subroutine cleanup() - call HydroDyn_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call HydroDyn_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call HydroDyn_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call HydroDyn_DestroyContState( x_m, ErrStat2, ErrMsg2 ) - call HydroDyn_DestroyInput( u_perturb, ErrStat2, ErrMsg2 ) - end subroutine cleanup - + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed END SUBROUTINE HD_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE HD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) -!.................................................................................................................................. - +SUBROUTINE HD_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(HydroDyn_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(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions (Y) with respect @@ -1892,109 +1999,62 @@ SUBROUTINE HD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) with respect !! to the continuous states (x) [intent in to avoid deallocation] - ! local variables - TYPE(HydroDyn_OutputType) :: y_p - TYPE(HydroDyn_OutputType) :: y_m - TYPE(HydroDyn_ContinuousStateType) :: x_p - TYPE(HydroDyn_ContinuousStateType) :: x_m - TYPE(HydroDyn_ContinuousStateType) :: x_perturb - REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, j, k, sOffset - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HD_JacobianPContState' - + CHARACTER(*), PARAMETER :: RoutineName = 'HD_JacobianPContState' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + INTEGER(IntKi) :: i, j, k, col, sOffset - ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' - - ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + + ! Copy State values to perturb + call HydroDyn_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call HydroDyn_VarsPackContState(Vars, x, m%Jac%x) - - ! make a copy of the continuous states to perturb - call HydroDyn_CopyContState( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - IF ( PRESENT( dYdx ) ) THEN + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + if (present(dYdx)) then - ! allocate dYdx if necessary if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Jac_ny, p%totalStates, 'dYdx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dYdx, m%Jac%Ny, m%Jac%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return end if - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call HydroDyn_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call HydroDyn_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - - do i=1,p%totalStates + ! Loop through state variables + do i = 1, size(Vars%x) - ! get x_op + delta x - call HydroDyn_CopyContState( x, x_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 - call HD_Perturb_x( p, i, 1, x_perturb, delta ) + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%x(i)%Num - ! compute y at x_op + delta x - call HydroDyn_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, 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 x_op - delta x - call HydroDyn_CopyContState( x, x_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 - call HD_Perturb_x( p, i, -1, x_perturb, delta ) - - ! compute y at x_op - delta x - call HydroDyn_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, 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, dYdx(:,i) ) - - end do - - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - call HydroDyn_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call HydroDyn_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - END IF + ! Calculate positive perturbation + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call HydroDyn_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call HydroDyn_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call HydroDyn_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call HydroDyn_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call HydroDyn_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call HydroDyn_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) + + ! Calculate column index + col = Vars%x(i)%iLoc(1) + j - 1 - IF ( PRESENT( dXdx ) ) THEN + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(Vars%y, Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) + end do + end do + + end if - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + IF (present(dXdx)) then ! allocate dXdu if necessary if (.not. allocated(dXdx)) then - call AllocAry(dXdx, p%totalStates, p%totalStates, 'dXdx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dXdx, m%Jac%Nx, m%Jac%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return end if + dXdx = 0.0_R8Ki ! Analytical Jacobians from State-space models @@ -2030,37 +2090,30 @@ SUBROUTINE HD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, IF ( PRESENT( dZdx ) ) THEN if (allocated(dZdx)) deallocate(dZdx) END IF - - call cleanup() contains - subroutine cleanup() - call HydroDyn_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call HydroDyn_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call HydroDyn_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call HydroDyn_DestroyContState( x_m, ErrStat2, ErrMsg2 ) - call HydroDyn_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) - end subroutine cleanup - + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed END SUBROUTINE HD_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the discrete states (xd). The partial derivatives dY/dxd, dX/dxd, dXd/dxd, and dZ/dxd are returned. -SUBROUTINE HD_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) -!.................................................................................................................................. - +SUBROUTINE HD_JacobianPDiscState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(HydroDyn_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(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdxd(:,:) !< Partial derivatives of output functions @@ -2075,66 +2128,48 @@ SUBROUTINE HD_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdxd(:,:) !< Partial derivatives of constraint state !! functions (Z) with respect to the !! discrete states (xd) [intent in to avoid deallocation] - - - ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' - + ! Calculate the partial derivative of the output functions (Y) with respect to the discrete states (xd) here: IF ( PRESENT( dYdxd ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the discrete states (xd) here: - ! allocate and set dYdxd - END IF + ! Calculate the partial derivative of the continuous state functions (X) with respect to the discrete states (xd) here: IF ( PRESENT( dXdxd ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the discrete states (xd) here: - ! allocate and set dXdxd - END IF + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the discrete states (xd) here: IF ( PRESENT( dXddxd ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the discrete states (xd) here: - ! allocate and set dXddxd - END IF + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the discrete states (xd) here: IF ( PRESENT( dZdxd ) ) THEN - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the discrete states (xd) here: - ! allocate and set dZdxd - END IF - END SUBROUTINE HD_JacobianPDiscState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the constraint states (z). The partial derivatives dY/dz, dX/dz, dXd/dz, and dZ/dz are returned. -SUBROUTINE HD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) -!.................................................................................................................................. +SUBROUTINE HD_JacobianPConstrState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(HydroDyn_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(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdz(:,:) !< Partial derivatives of output functions (Y) with respect @@ -2145,879 +2180,60 @@ SUBROUTINE HD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat !! to the constraint states (z) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdz(:,:) !< Partial derivatives of constraint state functions (Z) with respect !! to the constraint states (z) [intent in to avoid deallocation] - - - ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' + ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z) here: IF ( PRESENT( dYdz ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z) here: - ! allocate and set dYdz - END IF + ! Calculate the partial derivative of the continuous state functions (X) with respect to the constraint states (z) here: IF ( PRESENT( dXdz ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the constraint states (z) here: - ! allocate and set dXdz - END IF + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the constraint states (z) here: IF ( PRESENT( dXddz ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the constraint states (z) here: - ! allocate and set dXddz - END IF + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z) here: IF ( PRESENT( dZdz ) ) THEN - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z) here: - ! allocate and set dZdz - END IF END SUBROUTINE HD_JacobianPConstrState !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the Jacobian parameters and initialization outputs for the linearized outputs. -SUBROUTINE HD_Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) - - TYPE(HydroDyn_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(HydroDyn_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(HydroDyn_InitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine - - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables: - INTEGER(IntKi) :: i,index_last, index_next - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HD_Init_Jacobian_y' - - - - ErrStat = ErrID_None - ErrMsg = "" - - - ! determine how many outputs there are in the Jacobians - p%Jac_ny = 0 - if ( y%Morison%Mesh%Committed ) then - p%Jac_ny = p%Jac_ny + y%Morison%Mesh%NNodes * 6 ! 3 Force, Moment, at each node on the morison mesh - end if - if ( y%WAMITMesh%Committed ) then - p%Jac_ny = p%Jac_ny + y%WAMITMesh%NNodes * 6 ! 3 Force, Moment, at the WAMIT reference Point(s) - end if - - p%Jac_ny = p%Jac_ny + p%NumTotalOuts ! WriteOutput values - - - !................. - ! set linearization output names: - !................. - CALL AllocAry(InitOut%LinNames_y, p%Jac_ny, 'LinNames_y', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! We do not need RotFrame_y for this module and the glue code with handle the fact that we did not allocate the array and hence set all values to false at the glue-code level - ! Same with RotFrame_x - !CALL AllocAry(InitOut%RotFrame_y, p%Jac_ny, 'RotFrame_y', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - - - - index_next = 1 - if ( y%Morison%Mesh%Committed ) then - index_last = index_next - call PackLoadMesh_Names(y%Morison%Mesh, 'MorisonLoads', InitOut%LinNames_y, index_next) - end if - - if ( y%WAMITMesh%Committed ) then - index_last = index_next - call PackLoadMesh_Names(y%WAMITMesh, 'WAMITLoads', InitOut%LinNames_y, index_next) - end if - - index_last = index_next - - do i=1,p%NumTotalOuts - InitOut%LinNames_y(i+index_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) !trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units - end do - - - -END SUBROUTINE HD_Init_Jacobian_y - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the Jacobian parameters and initialization outputs for the linearized continuous states. -SUBROUTINE HD_Init_Jacobian_x( p, InitOut, ErrStat, ErrMsg) - - TYPE(HydroDyn_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(HydroDyn_InitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine - - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HD_Init_Jacobian_x' - - ! local variables: - INTEGER(IntKi) :: i, j, k, l, spdof, indx - CHARACTER(10) :: dofLabels(6) - ErrStat = ErrID_None - ErrMsg = "" - indx = 1 - - ! Need to determine how many wamit body objects there are - p%totalExctnStates = 0 - p%totalRdtnStates = 0 - do j = 1, p%nWAMITObj - p%totalExctnStates = p%totalExctnStates + p%WAMIT(j)%SS_Exctn%numStates !numStates defaults to zero in the case where ExctnMod = 0 instead of 2 - p%totalRdtnStates = p%totalRdtnStates + p%WAMIT(j)%SS_Rdtn%numStates !numStates defaults to zero in the case where RdtnMod = 0 instead of 2 - end do - p%totalStates = p%totalExctnStates + p%totalRdtnStates - - if ( p%totalStates == 0 ) return ! No states, so return and do not allocate the following arrays. This lets the glue-code know that the module does not have states - - ! allocate space for the row/column names and for perturbation sizes - call allocAry(p%dx, p%totalStates, 'p%dx', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%LinNames_x, p%totalStates, 'LinNames_x' , ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%DerivOrder_x, p%totalStates, 'DerivOrder_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - ! All Hydrodyn continuous states are max order = 1 - if ( allocated(InitOut%DerivOrder_x) ) InitOut%DerivOrder_x = 1 - - ! set perturbation sizes: p%dx - k = 1 - do j = 1, p%nWAMITObj - do i = 1, p%WAMIT(j)%SS_Exctn%numStates - p%dx(k) = 20000.0_R8Ki * D2R_D - k=k+1 - end do - end do - do j = 1, p%nWAMITObj - do i = 1, p%WAMIT(j)%SS_Rdtn%numStates - p%dx(k) = 2.0_R8Ki * D2R_D - k=k+1 - end do - end do - - !---------------- - ! SS_Exctn states - - dofLabels = (/'PtfmSg ','PtfmSw ','PtfmHv ','PtfmR ','PtfmP ','PtfmY '/) - if (p%totalExctnStates>0) then - do l=1,p%nWAMITObj - ! set linearization state names: - do j = 1, 6 - spdof = p%WAMIT(l)%SS_Exctn%spdof(j) - if ( p%NBodyMod == 1 ) then - do i = 1,spdof - InitOut%LinNames_x(indx) = 'Exctn'//trim(dofLabels(j))//trim(num2lstr(i)) - indx = indx + 1 - end do - else - do i = 1,spdof - InitOut%LinNames_x(indx) = 'B'//trim(num2lstr(l))//'Exctn'//trim(dofLabels(j))//trim(num2lstr(i)) - indx = indx + 1 - end do - end if - end do - end do - endif - - !---------------- - ! SS_Rdtn states - - if (p%totalRdtnStates>0) then - do l=1,p%nWAMITObj - ! set linearization state names: - do j = 1, 6 - spdof = p%WAMIT(l)%SS_Rdtn%spdof(j) - if ( p%NBodyMod == 1 ) then - do i = 1,spdof - InitOut%LinNames_x(indx) = 'Rdtn'//trim(dofLabels(j))//trim(num2lstr(i)) - indx = indx + 1 - end do - else - do i = 1,spdof - InitOut%LinNames_x(indx) = 'B'//trim(num2lstr(l))//'Rdtn'//trim(dofLabels(j))//trim(num2lstr(i)) - indx = indx + 1 - end do - end if - end do - end do - endif -END SUBROUTINE HD_Init_Jacobian_x -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the array that maps rows/columns of the Jacobian to specific mesh fields. -!! Do not change the order of this packing without changing corresponding linearization routines ! -SUBROUTINE HD_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) - - TYPE(HydroDyn_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(HydroDyn_InputType) , INTENT(IN ) :: u !< inputs - TYPE(HydroDyn_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(HydroDyn_InitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HD_Init_Jacobian' - - ! local variables: - INTEGER(IntKi) :: i, j, index, nu, i_meshField, m, meshFieldCount - integer(IntKi), parameter :: nu_extended = 4 ! 4 total extended inputs: WaveElev0 from SeaSt, HWindSpeed / PLexp / PropagationDir from IfW (turbulent sea current) - REAL(R8Ki) :: perturb_t, perturb - LOGICAL :: FieldMask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing - - - - ErrStat = ErrID_None - ErrMsg = "" - - - call HD_Init_Jacobian_y( p, y, InitOut, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call HD_Init_Jacobian_x( p, InitOut, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - - ! determine how many inputs there are in the Jacobians - nu = 0; - if ( u%Morison%Mesh%Committed ) then - nu = u%Morison%Mesh%NNodes * 18 ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node - end if - if ( u%WAMITMesh%Committed ) then - nu = nu + u%WAMITMesh%NNodes * 18 ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node - end if - - nu = nu + u%PRPMesh%NNodes * 18 ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node - - ! DO NOT Add the extended inputs WaveElev0, HWindSpeed / PLexp / PropagationDir when computing the size of p%Jac_u_indx -!FIXME: extended inputs will need to be added later to get HWindSpeed / PLexp / PropagationDir from sea currents from IfW/FlowField in - - - ! note: all other inputs are ignored - - !.................... - ! fill matrix to store index to help us figure out what the ith value of the u vector really means - ! (see hydrodyn::HD_perturb_u ... these MUST match ) - ! column 1 indicates module's mesh and field - ! column 2 indicates the first index of the acceleration/load field - ! column 3 is the node - !.................... - - !............... - ! HD input mappings stored in p%Jac_u_indx: - !............... - call AllocAry(p%Jac_u_indx, nu, 3, 'p%Jac_u_indx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - index = 1 - meshFieldCount = 0 - - if ( u%Morison%Mesh%Committed ) then - !Module/Mesh/Field: u%Morison%Mesh%TranslationDisp = 1; - !Module/Mesh/Field: u%Morison%Mesh%Orientation = 2; - !Module/Mesh/Field: u%Morison%Mesh%TranslationVel = 3; - !Module/Mesh/Field: u%Morison%Mesh%RotationVel = 4; - !Module/Mesh/Field: u%Morison%Mesh%TranslationAcc = 5; - !Module/Mesh/Field: u%Morison%Mesh%RotationAcc = 6; - - do i_meshField = 1,6 - do i=1,u%Morison%Mesh%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%Morison%Mesh%{TranslationDisp/Orientation/TranslationVel/RotationVel/TranslationAcc/RotationAcc} = m - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - - end do !i_meshField - meshFieldCount = 6 - - end if - - if ( u%WAMITMesh%Committed ) then - !Module/Mesh/Field: u%WAMITMesh%TranslationDisp = 7 or 1; - !Module/Mesh/Field: u%WAMITMesh%Orientation = 8 or 2; - !Module/Mesh/Field: u%WAMITMesh%TranslationVel = 9 or 3; - !Module/Mesh/Field: u%WAMITMesh%RotationVel = 10 or 4; - !Module/Mesh/Field: u%WAMITMesh%TranslationAcc = 11 or 5; - !Module/Mesh/Field: u%WAMITMesh%RotationAcc = 12 or 6; - do i_meshField = 1,6 - do i=1,u%WAMITMesh%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = meshFieldCount + i_meshField - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do !i_meshField - meshFieldCount = meshFieldCount + 6 - end if - - !Module/Mesh/Field: u%PRPMesh%TranslationDisp = 13 or 7 or 1; - !Module/Mesh/Field: u%PRPMesh%Orientation = 14 or 8 or 2; - !Module/Mesh/Field: u%PRPMesh%TranslationVel = 15 or 9 or 3; - !Module/Mesh/Field: u%PRPMesh%RotationVel = 16 or 10 or 4; - !Module/Mesh/Field: u%PRPMesh%TranslationAcc = 17 or 11 or 5; - !Module/Mesh/Field: u%PRPMesh%RotationAcc = 18 or 12 or 6; - do i_meshField = 1,6 - do i=1,u%PRPMesh%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = meshFieldCount + i_meshField - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do !i_meshField - meshFieldCount = meshFieldCount + 6 - - !................ - ! input perturbations, du: - !................ - - call AllocAry(p%du, meshFieldCount, 'p%du', ErrStat2, ErrMsg2) ! number of unique values in p%Jac_u_indx(:,1) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - - perturb_t = 0.02_ReKi*D2R * max(p%WaveField%EffWtrDpth,1.0_ReKi) ! translation input scaling - perturb = 2*D2R ! rotational input scaling - - index = 0 - if ( u%Morison%Mesh%Committed ) then - p%du(1) = perturb_t ! u%Morison%Mesh%TranslationDisp - p%du(2) = perturb ! u%Morison%Mesh%Orientation - p%du(3) = perturb_t ! u%Morison%Mesh%TranslationVel - p%du(4) = perturb ! u%Morison%Mesh%RotationVel - p%du(5) = perturb_t ! u%Morison%Mesh%TranslationAcc - p%du(6) = perturb ! u%Morison%Mesh%RotationAcc - index = 6 - end if - - if ( u%WAMITMesh%Committed ) then - p%du(index + 1) = perturb_t ! u%WAMITMesh%TranslationDisp - p%du(index + 2) = perturb ! u%WAMITMesh%Orientation - p%du(index + 3) = perturb_t ! u%WAMITMesh%TranslationVel - p%du(index + 4) = perturb ! u%WAMITMesh%RotationVel - p%du(index + 5) = perturb_t ! u%WAMITMesh%TranslationAcc - p%du(index + 6) = perturb ! u%WAMITMesh%RotationAcc - index = index + 6 - end if - - p%du(index + 1) = perturb_t ! u%PRPMesh%TranslationDisp - p%du(index + 2) = perturb ! u%PRPMesh%Orientation - p%du(index + 3) = perturb_t ! u%PRPMesh%TranslationVel - p%du(index + 4) = perturb ! u%PRPMesh%RotationVel - p%du(index + 5) = perturb_t ! u%PRPMesh%TranslationAcc - p%du(index + 6) = perturb ! u%PRPMesh%RotationAcc - - !................ - ! names of the columns, InitOut%LinNames_u: - !................ - call AllocAry(InitOut%LinNames_u, nu+nu_extended, 'LinNames_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! We do not need RotFrame_u for this module and the glue code with handle the fact that we did not allocate the array and hence set all values to false at the glue-code level - !call AllocAry(InitOut%RotFrame_u, nu+nu_extended, 'RotFrame_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call AllocAry(InitOut%IsLoad_u, nu+nu_extended, 'IsLoad_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - InitOut%IsLoad_u = .false. ! HD's inputs are NOT loads - - index = 1 - if ( u%Morison%Mesh%Committed ) then - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TRANSLATIONVEL) = .true. - FieldMask(MASKID_ROTATIONVEL) = .true. - FieldMask(MASKID_TRANSLATIONACC) = .true. - FieldMask(MASKID_ROTATIONACC) = .true. - call PackMotionMesh_Names(u%Morison%Mesh, 'Morison', InitOut%LinNames_u, index, FieldMask=FieldMask) - - end if - - if ( u%WAMITMesh%Committed ) then - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - FieldMask(MASKID_ROTATIONVel) = .true. - FieldMask(MASKID_TRANSLATIONACC) = .true. - FieldMask(MASKID_ROTATIONACC) = .true. - call PackMotionMesh_Names(u%WAMITMesh, 'WAMIT', InitOut%LinNames_u, index, FieldMask=FieldMask) - end if - - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - FieldMask(MASKID_ROTATIONVel) = .true. - FieldMask(MASKID_TRANSLATIONACC) = .true. - FieldMask(MASKID_ROTATIONACC) = .true. - call PackMotionMesh_Names(u%PRPMesh, 'Platform-RefPt', InitOut%LinNames_u, index, FieldMask=FieldMask) - - ! Extended inputs - InitOut%LinNames_u(index) = 'Extended input: wave elevation at platform ref point, m'; index=index+1 - InitOut%LinNames_u(index) = 'Extended input: horizontal current speed (steady/uniform wind), m/s'; index=index+1 - InitOut%LinNames_u(index) = 'Extended input: vertical power-law shear exponent, -'; index=index+1 - InitOut%LinNames_u(index) = 'Extended input: propagation direction, rad'; index=index+1 - -END SUBROUTINE HD_Init_Jacobian -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine hydrodyn::HD_init_jacobian is consistant with this routine! -SUBROUTINE HD_Perturb_u( p, n, perturb_sign, u, du ) - - TYPE(HydroDyn_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(HydroDyn_InputType) , INTENT(INOUT) :: u !< perturbed HD inputs - REAL( R8Ki ) , INTENT( OUT) :: du !< amount that specific input was perturbed - - - ! local variables - integer :: fieldIndx - integer :: node, index - - index = 0 - fieldIndx = p%Jac_u_indx(n,2) - node = p%Jac_u_indx(n,3) - - du = p%du( p%Jac_u_indx(n,1) ) - - ! determine which mesh we're trying to perturb and perturb the input: - - ! If we do not have Morison meshes, then the following select cases will vary - if ( u%Morison%Mesh%Committed ) then - SELECT CASE( p%Jac_u_indx(n,1) ) - CASE ( 1) !Module/Mesh/Field: u%Morison%Mesh%TranslationDisp = 1 - u%Morison%Mesh%TranslationDisp (fieldIndx,node) = u%Morison%Mesh%TranslationDisp (fieldIndx,node) + du * perturb_sign - CASE ( 2) !Module/Mesh/Field: u%Morison%Mesh%Orientation = 2 - CALL PerturbOrientationMatrix( u%Morison%Mesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.false. ) - CASE ( 3) !Module/Mesh/Field: u%Morison%Mesh%TranslationVel = 3 - u%Morison%Mesh%TranslationVel( fieldIndx,node) = u%Morison%Mesh%TranslationVel( fieldIndx,node) + du * perturb_sign - CASE ( 4) !Module/Mesh/Field: u%Morison%Mesh%RotationVel = 4 - u%Morison%Mesh%RotationVel (fieldIndx,node) = u%Morison%Mesh%RotationVel (fieldIndx,node) + du * perturb_sign - CASE ( 5) !Module/Mesh/Field: u%Morison%Mesh%TranslationAcc = 5 - u%Morison%Mesh%TranslationAcc( fieldIndx,node) = u%Morison%Mesh%TranslationAcc( fieldIndx,node) + du * perturb_sign - CASE ( 6) !Module/Mesh/Field: u%Morison%Mesh%RotationAcc = 6 - u%Morison%Mesh%RotationAcc(fieldIndx,node) = u%Morison%Mesh%RotationAcc(fieldIndx,node) + du * perturb_sign - end select - if ( u%WAMITMesh%Committed ) then - SELECT CASE( p%Jac_u_indx(n,1) ) - CASE ( 7) !Module/Mesh/Field: u%WAMITMesh%TranslationDisp = 7 - u%WAMITMesh%TranslationDisp (fieldIndx,node) = u%WAMITMesh%TranslationDisp (fieldIndx,node) + du * perturb_sign - CASE ( 8) !Module/Mesh/Field: u%WAMITMesh%Orientation = 8 - CALL PerturbOrientationMatrix( u%WAMITMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.false. ) - CASE ( 9) !Module/Mesh/Field: u%WAMITMesh%TranslationVel = 9 - u%WAMITMesh%TranslationVel( fieldIndx,node) = u%WAMITMesh%TranslationVel( fieldIndx,node) + du * perturb_sign - CASE (10) !Module/Mesh/Field: u%WAMITMesh%RotationVel = 10 - u%WAMITMesh%RotationVel (fieldIndx,node) = u%WAMITMesh%RotationVel (fieldIndx,node) + du * perturb_sign - CASE (11) !Module/Mesh/Field: u%WAMITMesh%TranslationAcc = 11 - u%WAMITMesh%TranslationAcc( fieldIndx,node) = u%WAMITMesh%TranslationAcc( fieldIndx,node) + du * perturb_sign - CASE (12) !Module/Mesh/Field: u%WAMITMesh%RotationAcc = 12 - u%WAMITMesh%RotationAcc(fieldIndx,node) = u%WAMITMesh%RotationAcc(fieldIndx,node) + du * perturb_sign - END SELECT - SELECT CASE( p%Jac_u_indx(n,1) ) - CASE (13) !Module/Mesh/Field: u%PRPMesh%TranslationDisp = 13 - u%PRPMesh%TranslationDisp (fieldIndx,node) = u%PRPMesh%TranslationDisp (fieldIndx,node) + du * perturb_sign - CASE (14) !Module/Mesh/Field: u%PRPMesh%Orientation = 14 - CALL PerturbOrientationMatrix( u%PRPMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.false. ) - CASE (15) !Module/Mesh/Field: u%PRPMesh%TranslationVel = 15 - u%PRPMesh%TranslationVel( fieldIndx,node) = u%PRPMesh%TranslationVel( fieldIndx,node) + du * perturb_sign - CASE (16) !Module/Mesh/Field: u%PRPMesh%RotationVel = 16 - u%PRPMesh%RotationVel (fieldIndx,node) = u%PRPMesh%RotationVel (fieldIndx,node) + du * perturb_sign - CASE (17) !Module/Mesh/Field: u%PRPMesh%TranslationAcc = 17 - u%PRPMesh%TranslationAcc( fieldIndx,node) = u%PRPMesh%TranslationAcc( fieldIndx,node) + du * perturb_sign - CASE (18) !Module/Mesh/Field: u%PRPMesh%RotationAcc = 18 - u%PRPMesh%RotationAcc(fieldIndx,node) = u%PRPMesh%RotationAcc(fieldIndx,node) + du * perturb_sign - END SELECT - else - SELECT CASE( p%Jac_u_indx(n,1) ) - CASE ( 7) !Module/Mesh/Field: u%PRPMesh%TranslationDisp = 7 - u%PRPMesh%TranslationDisp (fieldIndx,node) = u%PRPMesh%TranslationDisp (fieldIndx,node) + du * perturb_sign - CASE ( 8) !Module/Mesh/Field: u%PRPMesh%Orientation = 8 - CALL PerturbOrientationMatrix( u%PRPMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.false. ) - CASE ( 9) !Module/Mesh/Field: u%PRPMesh%TranslationVel = 9 - u%PRPMesh%TranslationVel( fieldIndx,node) = u%PRPMesh%TranslationVel( fieldIndx,node) + du * perturb_sign - CASE (10) !Module/Mesh/Field: u%PRPMesh%RotationVel = 10 - u%PRPMesh%RotationVel (fieldIndx,node) = u%PRPMesh%RotationVel (fieldIndx,node) + du * perturb_sign - CASE (11) !Module/Mesh/Field: u%PRPMesh%TranslationAcc = 11 - u%PRPMesh%TranslationAcc( fieldIndx,node) = u%PRPMesh%TranslationAcc( fieldIndx,node) + du * perturb_sign - CASE (12) !Module/Mesh/Field: u%PRPMesh%RotationAcc = 12 - u%PRPMesh%RotationAcc(fieldIndx,node) = u%PRPMesh%RotationAcc(fieldIndx,node) + du * perturb_sign - END SELECT - end if - else if ( u%WAMITMesh%Committed ) then - SELECT CASE( p%Jac_u_indx(n,1) ) - CASE (1) !Module/Mesh/Field: u%WAMITMesh%TranslationDisp = 1 - u%WAMITMesh%TranslationDisp (fieldIndx,node) = u%WAMITMesh%TranslationDisp (fieldIndx,node) + du * perturb_sign - CASE (2) !Module/Mesh/Field: u%WAMITMesh%Orientation = 2 - CALL PerturbOrientationMatrix( u%WAMITMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.false. ) - CASE (3) !Module/Mesh/Field: u%WAMITMesh%TranslationVel = 3 - u%WAMITMesh%TranslationVel( fieldIndx,node) = u%WAMITMesh%TranslationVel( fieldIndx,node) + du * perturb_sign - CASE (4) !Module/Mesh/Field: u%WAMITMesh%RotationVel = 4 - u%WAMITMesh%RotationVel (fieldIndx,node) = u%WAMITMesh%RotationVel (fieldIndx,node) + du * perturb_sign - CASE (5) !Module/Mesh/Field: u%WAMITMesh%TranslationAcc = 5 - u%WAMITMesh%TranslationAcc( fieldIndx,node) = u%WAMITMesh%TranslationAcc( fieldIndx,node) + du * perturb_sign - CASE (6) !Module/Mesh/Field: u%WAMITMesh%RotationAcc = 6 - u%WAMITMesh%RotationAcc(fieldIndx,node) = u%WAMITMesh%RotationAcc(fieldIndx,node) + du * perturb_sign - END SELECT - SELECT CASE( p%Jac_u_indx(n,1) ) - CASE ( 7) !Module/Mesh/Field: u%PRPMesh%TranslationDisp = 7 - u%PRPMesh%TranslationDisp (fieldIndx,node) = u%PRPMesh%TranslationDisp (fieldIndx,node) + du * perturb_sign - CASE ( 8) !Module/Mesh/Field: u%PRPMesh%Orientation = 8 - CALL PerturbOrientationMatrix( u%PRPMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.false. ) - CASE ( 9) !Module/Mesh/Field: u%PRPMesh%TranslationVel = 9 - u%PRPMesh%TranslationVel( fieldIndx,node) = u%PRPMesh%TranslationVel( fieldIndx,node) + du * perturb_sign - CASE (10) !Module/Mesh/Field: u%PRPMesh%RotationVel = 10 - u%PRPMesh%RotationVel (fieldIndx,node) = u%PRPMesh%RotationVel (fieldIndx,node) + du * perturb_sign - CASE (11) !Module/Mesh/Field: u%PRPMesh%TranslationAcc = 11 - u%PRPMesh%TranslationAcc( fieldIndx,node) = u%PRPMesh%TranslationAcc( fieldIndx,node) + du * perturb_sign - CASE (12) !Module/Mesh/Field: u%PRPMesh%RotationAcc = 12 - u%PRPMesh%RotationAcc(fieldIndx,node) = u%PRPMesh%RotationAcc(fieldIndx,node) + du * perturb_sign - END SELECT - else - SELECT CASE( p%Jac_u_indx(n,1) ) - CASE ( 1) !Module/Mesh/Field: u%PRPMesh%TranslationDisp = 1 - u%PRPMesh%TranslationDisp (fieldIndx,node) = u%PRPMesh%TranslationDisp (fieldIndx,node) + du * perturb_sign - CASE ( 2) !Module/Mesh/Field: u%PRPMesh%Orientation = 2 - CALL PerturbOrientationMatrix( u%PRPMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.false. ) - CASE ( 3) !Module/Mesh/Field: u%PRPMesh%TranslationVel = 3 - u%PRPMesh%TranslationVel( fieldIndx,node) = u%PRPMesh%TranslationVel( fieldIndx,node) + du * perturb_sign - CASE ( 4) !Module/Mesh/Field: u%PRPMesh%RotationVel = 4 - u%PRPMesh%RotationVel (fieldIndx,node) = u%PRPMesh%RotationVel (fieldIndx,node) + du * perturb_sign - CASE ( 5) !Module/Mesh/Field: u%PRPMesh%TranslationAcc = 5 - u%PRPMesh%TranslationAcc( fieldIndx,node) = u%PRPMesh%TranslationAcc( fieldIndx,node) + du * perturb_sign - CASE ( 6) !Module/Mesh/Field: u%PRPMesh%RotationAcc = 6 - u%PRPMesh%RotationAcc(fieldIndx,node) = u%PRPMesh%RotationAcc(fieldIndx,node) + du * perturb_sign - END SELECT - end if - -!FIXME: when SeaState superposition with IfW/FlowField for current is enabled, we must also add in the perturbations of those extended inputs (HWindSpeed/PLexp/PropagationDir) -! Some revisions needed at that time: -! - expand p%Jac_u_indx to include the extended inputs (currently ignores them) -! - copy what was done in AD15 for perturbing these extended inputs (may require extensive modifications to data management) -! Until then, we should add a warning that linearization with IfW/FlowField currents in HD is not allowed for MHK turbines (no warning at present). -! -! Example code chunk from AD15. May be superceded by new linearization system later -! ! Extended inputs -! ! Module/Mesh/Field: HWindSpeed = 37 -! ! Module/Mesh/Field: PLexp = 38 -! ! Module/Mesh/Field: PropagationDir = 39 -! case(37,38,39) -! FlowField_du = 0.0_R8Ki -! select case( p%Jac_u_indx(n,1) ) -! case (37); FlowField_du(1) = du *perturb_sign -! case (38); FlowField_du(2) = du *perturb_sign -! case (39); FlowField_du(3) = du *perturb_sign -! end select -! call IfW_UniformWind_Perturb(FlowField_perturb, FlowField_du) -! call AD_CalcWind_Rotor(t, u_perturb, FlowField_perturb, p, RotInflow_perturb, StartNode, ErrStat, ErrMsg) -END SUBROUTINE HD_Perturb_u -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the continuous state array. -!! Do not change this without making sure subroutine HD_init_jacobian is consistant with this routine! -SUBROUTINE HD_Perturb_x( p, n, perturb_sign, x, dx ) - - TYPE(HydroDyn_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(HydroDyn_ContinuousStateType) , INTENT(INOUT) :: x !< perturbed ED states - REAL( R8Ki ) , INTENT( OUT) :: dx !< amount that specific state was perturbed - - - ! local variables - integer(intKi) :: i, j, k - - if ( p%totalStates == 0 ) return - - !Note: All excitation states for all bodies are stored 1st, then all radiation states - dx = p%dx(n) - k = 1 - - ! Find body index for exctn states - do i = 1, p%nWAMITObj - do j = 1, p%WAMIT(i)%SS_Exctn%numStates - if (n == k) then - x%WAMIT(i)%SS_Exctn%x(j) = x%WAMIT(i)%SS_Exctn%x(j) + dx * perturb_sign - return - end if - k = k + 1 - end do +subroutine HD_PackExtInputAry(Vars, u, ValAry) + type(ModVarsType), intent(in) :: Vars !< Module variables + type(HydroDyn_InputType), intent(in) :: u !< Inputs + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + + ! Loop through Input variables + do i = 1, size(Vars%u) + associate (Var => Vars%u(i)) + ! Select based on data location number + select case (Var%DL%Num) + case (HydroDyn_u_WaveElev0) + ! Wave elevation from SeaState + ValAry(Vars%u(i)%iLoc(1):Vars%u(i)%iLoc(2)) = 0.0_R8Ki + case (HydroDyn_u_HWindSpeed) + ! Current velocity from SeaState + ValAry(Vars%u(i)%iLoc(1):Vars%u(i)%iLoc(2)) = 0.0_R8Ki + case (HydroDyn_u_PLexp) + ! Current shear coefficient from SeaState + ValAry(Vars%u(i)%iLoc(1):Vars%u(i)%iLoc(2)) = 0.0_R8Ki + case (HydroDyn_u_PropagationDir) + ! Current propagation direction from SeaState + ValAry(Vars%u(i)%iLoc(1):Vars%u(i)%iLoc(2)) = 0.0_R8Ki + end select + end associate end do - - ! Find body index for rdtn states - do i = 1, p%nWAMITObj - do j = 1, p%WAMIT(i)%SS_Rdtn%numStates - if (n == k) then - x%WAMIT(i)%SS_Rdtn%x(j) = x%WAMIT(i)%SS_Rdtn%x(j) + dx * perturb_sign - return - end if - k = k + 1 - end do - end do - -END SUBROUTINE HD_Perturb_x - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine hydrodyn::HD_init_jacobian is consistant with this routine! -SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) - - TYPE(HydroDyn_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(HydroDyn_OutputType) , INTENT(IN ) :: y_p !< HD outputs at \f$ u + \Delta u \f$ or \f$ x + \Delta x \f$ (p=plus) - TYPE(HydroDyn_OutputType) , INTENT(IN ) :: y_m !< HD outputs at \f$ u - \Delta u \f$ or \f$ x - \Delta x \f$ (m=minus) - REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta = \Delta u \f$ or \f$ delta = \Delta x \f$ - REAL(R8Ki) , INTENT(INOUT) :: dY(:) !< column of dYdu or dYdx: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial x_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ - - ! local variables: - - integer(IntKi) :: indx_first ! index indicating next value of dY to be filled - integer(IntKi) :: k - - - - - indx_first = 1 - if ( y_p%Morison%Mesh%Committed ) then - call PackLoadMesh_dY(y_p%Morison%Mesh, y_m%Morison%Mesh, dY, indx_first) - end if - if ( y_p%WAMITMesh%Committed ) then - call PackLoadMesh_dY(y_p%WAMITMesh, y_m%WAMITMesh, dY, indx_first) - end if - - do k=1,p%NumTotalOuts - dY(k+indx_first-1) = y_p%WriteOutput(k) - y_m%WriteOutput(k) - end do - - - - dY = dY / (2.0_R8Ki*delta) - -END SUBROUTINE Compute_dY - -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE HD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) - - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(HydroDyn_OutputType), INTENT(IN ) :: y !< Output at operating point - TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - - - - INTEGER(IntKi) :: i, j, index, nu - integer(IntKi), parameter :: nu_extended = 4 ! 4 total extended inputs: WaveElev0 from SeaSt, HWindSpeed / PLexp / PropagationDir from IfW (turbulent sea current) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HD_GetOP' - TYPE(HydroDyn_ContinuousStateType) :: dx !< derivative of continuous states at operating point - LOGICAL :: Mask(FIELDMASK_SIZE) !< flags to determine if this field is part of the packing - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' +end subroutine - !.................................. - IF ( PRESENT( u_op ) ) THEN - - if (.not. allocated(u_op)) then - - nu = size(p%Jac_u_indx,1) - - ! our operating point includes DCM (orientation) matrices, not just small angles like the perturbation matrices do - if ( u%Morison%Mesh%Committed ) then - nu = nu + u%Morison%Mesh%NNodes * 6 ! p%Jac_u_indx has 3 for Orientation, but we need 9 at each node - end if - if ( u%WAMITMesh%Committed ) then - nu = nu + u%WAMITMesh%NNodes * 6 ! p%Jac_u_indx has 3 for Orientation, but we need 9 at each node - end if - - nu = nu + u%PRPMesh%NNodes * 6 ! p%Jac_u_indx has 3 for Orientation, but we need 9 at each node - nu = nu + nu_extended ! Extended input - - call AllocAry(u_op, nu,'u_op',ErrStat2,ErrMsg2) ! - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - - end if - - Mask = .false. - Mask(MASKID_TRANSLATIONDISP) = .true. - Mask(MASKID_ORIENTATION) = .true. - Mask(MASKID_TRANSLATIONVEL) = .true. - Mask(MASKID_ROTATIONVEL) = .true. - Mask(MASKID_TRANSLATIONACC) = .true. - Mask(MASKID_ROTATIONACC) = .true. - - index = 1 - if ( u%Morison%Mesh%Committed ) then - call PackMotionMesh(u%Morison%Mesh, u_op, index, FieldMask=Mask) - end if - - if ( u%WAMITMesh%Committed ) then - call PackMotionMesh(u%WAMITMesh, u_op, index, FieldMask=Mask) - end if - - call PackMotionMesh(u%PRPMesh, u_op, index, FieldMask=Mask) - - ! extended inputs: - u_op(index) = 0.0_R8Ki; index=index+1 ! WaveElev0 -- linearization not allowed for non-zero - u_op(index) = 0.0_R8Ki; index=index+1 ! HWindSpeed - u_op(index) = 0.0_R8Ki; index=index+1 ! PLexp - u_op(index) = 0.0_R8Ki; index=index+1 ! PropagationDir - -!FIXME: when sea current from IfW/FlowField is enabled, this code must be updated and enabled -! !------------------------------ -! ! Extended inputs -- Linearization is only possible with Steady or Uniform Wind, so take advantage of that here -! ! Module/Mesh/Field: HWindSpeed = 37 -! ! Module/Mesh/Field: PLexp = 38 -! ! Module/Mesh/Field: PropagationDir = 39 -! call IfW_UniformWind_GetOP(p_AD%FlowField%Uniform, t, .false. , OP_out) -! ! HWindSpeed -! u_op(index) = OP_out(1); index = index + 1 -! ! PLexp -! u_op(index) = OP_out(2); index = index + 1 -! ! PropagationDir (include AngleH in calculation if any) -! u_op(index) = OP_out(3) + p_AD%FlowField%PropagationDir; index = index + 1 - - - END IF - - !.................................. - if ( PRESENT( y_op ) ) then - - if (.not. allocated(y_op)) then - call AllocAry(y_op, p%Jac_ny, 'y_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end if - - index = 1 - if ( y%Morison%Mesh%Committed ) then - call PackLoadMesh(y%Morison%Mesh, y_op, index) - end if - if ( y%WAMITMesh%Committed ) then - call PackLoadMesh(y%WAMITMesh, y_op, index) - end if - - index = index - 1 - do i=1,p%NumTotalOuts - y_op(i+index) = y%WriteOutput(i) - end do - - end if - - !.................................. - IF ( PRESENT( x_op ) ) THEN - - if ( p%totalStates == 0 ) return - - if ( y%WAMITMesh%Committed ) then - if (.not. allocated(x_op)) then - call AllocAry(x_op, p%totalStates,'x_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - end if - index = 1 - do j=1, p%nWAMITObj - do i=1,p%WAMIT(j)%SS_Exctn%numStates ! Loop through all DOFs - x_op(index) = x%WAMIT(j)%SS_Exctn%x(i) - index = index + 1 - end do - end do - do j=1, p%nWAMITObj - do i=1,p%WAMIT(j)%SS_Rdtn%numStates ! Loop through all DOFs - x_op(index) = x%WAMIT(j)%SS_Rdtn%x(i) - index = index + 1 - end do - end do - end if - END IF - - !.................................. - IF ( PRESENT( dx_op ) ) THEN - - if ( p%totalStates == 0 ) return - - if ( y%WAMITMesh%Committed ) then - if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%totalStates,'dx_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - end if - - call HydroDyn_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dx, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call HydroDyn_DestroyContState( dx, ErrStat2, ErrMsg2) - return - end if - index = 1 - do j=1, p%nWAMITObj - do i=1,p%WAMIT(j)%SS_Exctn%numStates ! Loop through all DOFs - dx_op(index) = dx%WAMIT(j)%SS_Exctn%x(i) - index = index + 1 - end do - end do - do j=1, p%nWAMITObj - do i=1,p%WAMIT(j)%SS_Rdtn%numStates ! Loop through all DOFs - dx_op(index) = dx%WAMIT(j)%SS_Rdtn%x(i) - index = index + 1 - end do - end do - call HydroDyn_DestroyContState( dx, ErrStat2, ErrMsg2) - end if - END IF - - !.................................. - IF ( PRESENT( xd_op ) ) THEN - END IF - - !.................................. - IF ( PRESENT( z_op ) ) THEN - END IF - -END SUBROUTINE HD_GetOP - - -!---------------------------------------------------------------------------------------------------------------------------------- END MODULE HydroDyn !********************************************************************************************************************************** diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 44d3a48264..8a40ecbb87 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -25,6 +25,11 @@ usefrom SeaSt_WaveField.txt param HydroDyn/HydroDyn unused INTEGER MaxHDOutputs - 510 - "The maximum number of output channels supported by this module" - param HydroDyn/HydroDyn unused INTEGER MaxUserOutputs - 5150 - " Total possible number of output channels: SS_Excitation = 7 + SS_Radiation = 7 + Morison= 4626 + HydroDyn=510 = 5150" - +param ^ ^ IntKi HydroDyn_u_WaveElev0 - -1 - "WaveElev0 Extended input DatLoc number" - +param ^ ^ IntKi HydroDyn_u_HWindSpeed - -2 - "HWindSpeed extended input DatLoc number" - +param ^ ^ IntKi HydroDyn_u_PLexp - -3 - "PLexp extended input DatLoc number" - +param ^ ^ IntKi HydroDyn_u_PropagationDir - -4 - "PropagationDir extended input DatLoc number" - + ######################### # ..... Input file data ........................................................................................................... # This is data defined in the Input File for this module (or could otherwise be passed in) @@ -82,6 +87,7 @@ typedef ^ ^ ReKi # # Define outputs from the initialization routine here: # +typedef ^ InitOutputType ModVarsType Vars - - - "Module Variables" - typedef ^ InitOutputType Morison_InitOutputType Morison - - - "Initialization output from the Morison module" - typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "The is the list of all HD-related output channel header strings (includes all sub-module channels)" - typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "The is the list of all HD-related output channel unit strings (includes all sub-module channels)" - @@ -121,20 +127,7 @@ typedef ^ ConstraintStateType Morison_Con # typedef ^ OtherStateType WAMIT_OtherStateType WAMIT {:} - - "OtherState information from the WAMIT module" - typedef ^ ^ Morison_OtherStateType Morison - - - "OtherState information from the Morison module" - -# ..... Misc/Optimization variables................................................................................................. -# Define any data that are used only for efficiency purposes (these variables are not associated with time): -# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. -typedef ^ MiscVarType MeshType AllHdroOrigin - - - "An intermediate mesh used to transfer hydrodynamic loads from the various HD-related meshes to the AllHdroOrigin mesh" - -typedef ^ ^ HD_ModuleMapType HD_MeshMap - - - -typedef ^ ^ INTEGER Decimate - - - "The output decimation counter" - -typedef ^ ^ DbKi LastOutTime - - - "Last time step which was written to the output file (sec)" - -typedef ^ ^ ReKi F_PtfmAdd {:} - - "The total forces and moments due to additional pre-load, stiffness, and damping" - -typedef ^ ^ ReKi F_Hydro {6} - - "The total hydrodynamic forces and moments integrated about the (0,0,0) platform reference point" - -typedef ^ ^ ReKi F_Waves {:} - - "The total waves forces on a WAMIT body calculated by first and second order methods (WAMIT and WAMIT2 modules)" - -typedef ^ ^ WAMIT_MiscVarType WAMIT {:} - - "misc var information from the WAMIT module" - -typedef ^ ^ WAMIT2_MiscVarType WAMIT2 {:} - - "misc var information from the WAMIT2 module" - -typedef ^ ^ Morison_MiscVarType Morison - - - "misc var information from the Morison module" - -typedef ^ ^ WAMIT_InputType u_WAMIT {:} - - "WAMIT module inputs" - +# # ..... Parameters ................................................................................................................ # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: @@ -190,3 +183,24 @@ typedef ^ OutputType WAMIT2_Outpu typedef ^ ^ Morison_OutputType Morison - - - "Morison module outputs" - typedef ^ OutputType MeshType WAMITMesh - - - "Point Loads at the WAMIT reference point(s) in the inertial frame" - typedef ^ ^ ReKi WriteOutput {:} - - "Outputs to be written to the output file(s)" - +# +# +# ..... Misc/Optimization variables................................................................................................. +# Define any data that are used only for efficiency purposes (these variables are not associated with time): +# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. +typedef ^ MiscVarType ModJacType Jac - - - "Values corresponding to module variables" - +typedef ^ ^ HydroDyn_ContinuousStateType x_perturb - - - "Temporary variables for Jacobian calculations" - +typedef ^ ^ HydroDyn_InputType u_perturb - - - "Temporary variables for Jacobian calculations" - +typedef ^ ^ HydroDyn_ContinuousStateType dxdt_lin - - - "Temporary variables for Jacobian calculations" - +typedef ^ ^ HydroDyn_OutputType y_lin - - - "Temporary variables for Jacobian calculations" - +typedef ^ ^ MeshType AllHdroOrigin - - - "An intermediate mesh used to transfer hydrodynamic loads from the various HD-related meshes to the AllHdroOrigin mesh" - +typedef ^ ^ HD_ModuleMapType HD_MeshMap - - - +typedef ^ ^ INTEGER Decimate - - - "The output decimation counter" - +typedef ^ ^ DbKi LastOutTime - - - "Last time step which was written to the output file (sec)" - +typedef ^ ^ ReKi F_PtfmAdd {:} - - "The total forces and moments due to additional pre-load, stiffness, and damping" - +typedef ^ ^ ReKi F_Hydro {6} - - "The total hydrodynamic forces and moments integrated about the (0,0,0) platform reference point" - +typedef ^ ^ ReKi F_Waves {:} - - "The total waves forces on a WAMIT body calculated by first and second order methods (WAMIT and WAMIT2 modules)" - +typedef ^ ^ WAMIT_MiscVarType WAMIT {:} - - "misc var information from the WAMIT module" - +typedef ^ ^ WAMIT2_MiscVarType WAMIT2 {:} - - "misc var information from the WAMIT2 module" - +typedef ^ ^ Morison_MiscVarType Morison - - - "misc var information from the Morison module" - +typedef ^ ^ WAMIT_InputType u_WAMIT {:} - - "WAMIT module inputs" - diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index 4c2ccf61bb..92093512ad 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -179,6 +179,7 @@ PROGRAM HydroDynDriver call SeaSt_Init( InitInData_SeaSt, u_SeaSt(1), p_SeaSt, x_SeaSt, xd_SeaSt, z_SeaSt, OtherState_SeaSt, y_SeaSt, m_SeaSt, Interval, InitOutData_SeaSt, ErrStat, ErrMsg ) SeaState_Initialized = .true. CALL CheckError() + p_SeaSt%WaveField%hasCurrField = .FALSE. if ( Interval /= drvrData%TimeInterval) then ErrMsg = 'The SeaState Module attempted to change timestep interval, but this is not allowed. The SeaState Module must use the Driver Interval.' diff --git a/modules/hydrodyn/src/HydroDyn_DriverSubs.f90 b/modules/hydrodyn/src/HydroDyn_DriverSubs.f90 index 0a2a5bb773..5a370672ce 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverSubs.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverSubs.f90 @@ -811,7 +811,7 @@ SUBROUTINE SetHDInputs(time, n, u_HD, mappingData, drvrData, ErrStat, ErrMsg) integer(IntKi) :: errStat2 ! temporary error status of the operation character(ErrMsgLen) :: errMsg2 ! temporary error message character(*), parameter :: RoutineName = 'SetHDInputs' - real(R8Ki) :: yInterp(size(drvrData%PRPin,2)) + real(R8Ki), allocatable :: yInterp(:) integer(intKi) :: indxHigh, indxMid, indxLow integer(intKi) :: i @@ -820,6 +820,10 @@ SUBROUTINE SetHDInputs(time, n, u_HD, mappingData, drvrData, ErrStat, ErrMsg) ! PRPInputsMod 2: Reads time series of positions, velocities, and accelerations for the platform reference point IF ( drvrData%PRPInputsMod == 2 ) THEN + + call AllocAry(yInterp, size(drvrData%PRPin,2), "yInterp", ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InterpStpMat( time, drvrData%PRPinTime, drvrData%PRPin, mappingData%Ind, size(drvrData%PRPinTime), yInterp ) u_HD%PRPMesh%TranslationDisp(:,1) = yInterp(1:3) diff --git a/modules/hydrodyn/src/HydroDyn_Input.f90 b/modules/hydrodyn/src/HydroDyn_Input.f90 index 98d97dea82..67b443815a 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -297,7 +297,7 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, FileInfo_In, InputFi ! AddCLin do i=1,6*InputFileData%vecMultiplier - write(strI,'(I1)') i + write(strI,'(I2)') i call ParseAry( FileInfo_In, CurLine, ' Row '//strI//' of the additional linear stiffness matrix', & tmpVec2, 6*InputFileData%NBody, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 7d928a77b2..c09f4d20f9 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -39,8 +39,12 @@ MODULE HydroDyn_Types USE Morison_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: MaxHDOutputs = 510 ! The maximum number of output channels supported by this module [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: MaxUserOutputs = 5150 ! Total possible number of output channels: SS_Excitation = 7 + SS_Radiation = 7 + Morison= 4626 + HydroDyn=510 = 5150 [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MaxHDOutputs = 510 ! The maximum number of output channels supported by this module [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MaxUserOutputs = 5150 ! Total possible number of output channels: SS_Excitation = 7 + SS_Radiation = 7 + Morison= 4626 + HydroDyn=510 = 5150 [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_u_WaveElev0 = -1 ! WaveElev0 Extended input DatLoc number [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_u_HWindSpeed = -2 ! HWindSpeed extended input DatLoc number [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_u_PLexp = -3 ! PLexp extended input DatLoc number [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: HydroDyn_u_PropagationDir = -4 ! PropagationDir extended input DatLoc number [-] ! ========= HydroDyn_InputFile ======= TYPE, PUBLIC :: HydroDyn_InputFile LOGICAL :: EchoFlag = .false. !< Echo the input file [-] @@ -99,6 +103,7 @@ MODULE HydroDyn_Types ! ======================= ! ========= HydroDyn_InitOutputType ======= TYPE, PUBLIC :: HydroDyn_InitOutputType + TYPE(ModVarsType) :: Vars !< Module Variables [-] TYPE(Morison_InitOutputType) :: Morison !< Initialization output from the Morison module [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< The is the list of all HD-related output channel header strings (includes all sub-module channels) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< The is the list of all HD-related output channel unit strings (includes all sub-module channels) [-] @@ -142,21 +147,6 @@ MODULE HydroDyn_Types TYPE(Morison_OtherStateType) :: Morison !< OtherState information from the Morison module [-] END TYPE HydroDyn_OtherStateType ! ======================= -! ========= HydroDyn_MiscVarType ======= - TYPE, PUBLIC :: HydroDyn_MiscVarType - TYPE(MeshType) :: AllHdroOrigin !< An intermediate mesh used to transfer hydrodynamic loads from the various HD-related meshes to the AllHdroOrigin mesh [-] - TYPE(HD_ModuleMapType) :: HD_MeshMap - INTEGER(IntKi) :: Decimate = 0_IntKi !< The output decimation counter [-] - REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Last time step which was written to the output file (sec) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_PtfmAdd !< The total forces and moments due to additional pre-load, stiffness, and damping [-] - REAL(ReKi) , DIMENSION(1:6) :: F_Hydro = 0.0_ReKi !< The total hydrodynamic forces and moments integrated about the (0,0,0) platform reference point [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_Waves !< The total waves forces on a WAMIT body calculated by first and second order methods (WAMIT and WAMIT2 modules) [-] - TYPE(WAMIT_MiscVarType) , DIMENSION(:), ALLOCATABLE :: WAMIT !< misc var information from the WAMIT module [-] - TYPE(WAMIT2_MiscVarType) , DIMENSION(:), ALLOCATABLE :: WAMIT2 !< misc var information from the WAMIT2 module [-] - TYPE(Morison_MiscVarType) :: Morison !< misc var information from the Morison module [-] - TYPE(WAMIT_InputType) , DIMENSION(:), ALLOCATABLE :: u_WAMIT !< WAMIT module inputs [-] - END TYPE HydroDyn_MiscVarType -! ======================= ! ========= HydroDyn_ParameterType ======= TYPE, PUBLIC :: HydroDyn_ParameterType INTEGER(IntKi) :: nWAMITObj = 0_IntKi !< number of WAMIT input files and matrices. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1 [-] @@ -211,7 +201,47 @@ MODULE HydroDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Outputs to be written to the output file(s) [-] END TYPE HydroDyn_OutputType ! ======================= -CONTAINS +! ========= HydroDyn_MiscVarType ======= + TYPE, PUBLIC :: HydroDyn_MiscVarType + TYPE(ModJacType) :: Jac !< Values corresponding to module variables [-] + TYPE(HydroDyn_ContinuousStateType) :: x_perturb !< Temporary variables for Jacobian calculations [-] + TYPE(HydroDyn_InputType) :: u_perturb !< Temporary variables for Jacobian calculations [-] + TYPE(HydroDyn_ContinuousStateType) :: dxdt_lin !< Temporary variables for Jacobian calculations [-] + TYPE(HydroDyn_OutputType) :: y_lin !< Temporary variables for Jacobian calculations [-] + TYPE(MeshType) :: AllHdroOrigin !< An intermediate mesh used to transfer hydrodynamic loads from the various HD-related meshes to the AllHdroOrigin mesh [-] + TYPE(HD_ModuleMapType) :: HD_MeshMap + INTEGER(IntKi) :: Decimate = 0_IntKi !< The output decimation counter [-] + REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Last time step which was written to the output file (sec) [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_PtfmAdd !< The total forces and moments due to additional pre-load, stiffness, and damping [-] + REAL(ReKi) , DIMENSION(1:6) :: F_Hydro = 0.0_ReKi !< The total hydrodynamic forces and moments integrated about the (0,0,0) platform reference point [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_Waves !< The total waves forces on a WAMIT body calculated by first and second order methods (WAMIT and WAMIT2 modules) [-] + TYPE(WAMIT_MiscVarType) , DIMENSION(:), ALLOCATABLE :: WAMIT !< misc var information from the WAMIT module [-] + TYPE(WAMIT2_MiscVarType) , DIMENSION(:), ALLOCATABLE :: WAMIT2 !< misc var information from the WAMIT2 module [-] + TYPE(Morison_MiscVarType) :: Morison !< misc var information from the Morison module [-] + TYPE(WAMIT_InputType) , DIMENSION(:), ALLOCATABLE :: u_WAMIT !< WAMIT module inputs [-] + END TYPE HydroDyn_MiscVarType +! ======================= + integer(IntKi), public, parameter :: HydroDyn_x_WAMIT_SS_Rdtn_x = 1 ! HydroDyn%WAMIT(DL%i1)%SS_Rdtn%x + integer(IntKi), public, parameter :: HydroDyn_x_WAMIT_SS_Exctn_x = 2 ! HydroDyn%WAMIT(DL%i1)%SS_Exctn%x + integer(IntKi), public, parameter :: HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState = 3 ! HydroDyn%WAMIT(DL%i1)%Conv_Rdtn%DummyContState + integer(IntKi), public, parameter :: HydroDyn_x_Morison_DummyContState = 4 ! HydroDyn%Morison%DummyContState + integer(IntKi), public, parameter :: HydroDyn_z_WAMIT_Conv_Rdtn_DummyConstrState = 5 ! HydroDyn%WAMIT%Conv_Rdtn%DummyConstrState + integer(IntKi), public, parameter :: HydroDyn_z_WAMIT_SS_Rdtn_DummyConstrState = 6 ! HydroDyn%WAMIT%SS_Rdtn%DummyConstrState + integer(IntKi), public, parameter :: HydroDyn_z_WAMIT_SS_Exctn_DummyConstrState = 7 ! HydroDyn%WAMIT%SS_Exctn%DummyConstrState + integer(IntKi), public, parameter :: HydroDyn_z_Morison_DummyConstrState = 8 ! HydroDyn%Morison%DummyConstrState + integer(IntKi), public, parameter :: HydroDyn_u_Morison_Mesh = 9 ! HydroDyn%Morison%Mesh + integer(IntKi), public, parameter :: HydroDyn_u_Morison_PtfmRefY = 10 ! HydroDyn%Morison%PtfmRefY + integer(IntKi), public, parameter :: HydroDyn_u_WAMITMesh = 11 ! HydroDyn%WAMITMesh + integer(IntKi), public, parameter :: HydroDyn_u_PRPMesh = 12 ! HydroDyn%PRPMesh + integer(IntKi), public, parameter :: HydroDyn_y_WAMIT_Mesh = 13 ! HydroDyn%WAMIT(DL%i1)%Mesh + integer(IntKi), public, parameter :: HydroDyn_y_WAMIT2_Mesh = 14 ! HydroDyn%WAMIT2(DL%i1)%Mesh + integer(IntKi), public, parameter :: HydroDyn_y_Morison_Mesh = 15 ! HydroDyn%Morison%Mesh + integer(IntKi), public, parameter :: HydroDyn_y_Morison_VisMesh = 16 ! HydroDyn%Morison%VisMesh + integer(IntKi), public, parameter :: HydroDyn_y_Morison_WriteOutput = 17 ! HydroDyn%Morison%WriteOutput + integer(IntKi), public, parameter :: HydroDyn_y_WAMITMesh = 18 ! HydroDyn%WAMITMesh + integer(IntKi), public, parameter :: HydroDyn_y_WriteOutput = 19 ! HydroDyn%WriteOutput + +contains subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) type(HydroDyn_InputFile), intent(in) :: SrcInputFileData @@ -708,6 +738,9 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod character(*), parameter :: RoutineName = 'HydroDyn_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return call Morison_CopyInitOutput(SrcInitOutputData%Morison, DstInitOutputData%Morison, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -809,6 +842,8 @@ subroutine HydroDyn_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'HydroDyn_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call Morison_DestroyInitOutput(InitOutputData%Morison, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%WriteOutputHdr)) then @@ -841,6 +876,7 @@ subroutine HydroDyn_PackInitOutput(RF, Indata) type(HydroDyn_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackInitOutput' if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackModVarsType(RF, InData%Vars) call Morison_PackInitOutput(RF, InData%Morison) call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) @@ -861,6 +897,7 @@ subroutine HydroDyn_UnPackInitOutput(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars call Morison_UnpackInitOutput(RF, OutData%Morison) ! Morison call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return @@ -1311,452 +1348,198 @@ subroutine HydroDyn_UnPackOtherState(RF, OutData) call Morison_UnpackOtherState(RF, OutData%Morison) ! Morison end subroutine -subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(HydroDyn_MiscVarType), intent(inout) :: SrcMiscData - type(HydroDyn_MiscVarType), intent(inout) :: DstMiscData +subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_ParameterType), intent(in) :: SrcParamData + type(HydroDyn_ParameterType), intent(inout) :: DstParamData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'HydroDyn_CopyMisc' + character(*), parameter :: RoutineName = 'HydroDyn_CopyParam' ErrStat = ErrID_None ErrMsg = '' - call MeshCopy(SrcMiscData%AllHdroOrigin, DstMiscData%AllHdroOrigin, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call HydroDyn_CopyHD_ModuleMapType(SrcMiscData%HD_MeshMap, DstMiscData%HD_MeshMap, CtrlCode, ErrStat2, ErrMsg2) + DstParamData%nWAMITObj = SrcParamData%nWAMITObj + DstParamData%vecMultiplier = SrcParamData%vecMultiplier + if (allocated(SrcParamData%WAMIT)) then + LB(1:1) = lbound(SrcParamData%WAMIT) + UB(1:1) = ubound(SrcParamData%WAMIT) + if (.not. allocated(DstParamData%WAMIT)) then + allocate(DstParamData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyParam(SrcParamData%WAMIT(i1), DstParamData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%WAMIT2)) then + LB(1:1) = lbound(SrcParamData%WAMIT2) + UB(1:1) = ubound(SrcParamData%WAMIT2) + if (.not. allocated(DstParamData%WAMIT2)) then + allocate(DstParamData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WAMIT2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT2_CopyParam(SrcParamData%WAMIT2(i1), DstParamData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%WAMIT2used = SrcParamData%WAMIT2used + call Morison_CopyParam(SrcParamData%Morison, DstParamData%Morison, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - DstMiscData%Decimate = SrcMiscData%Decimate - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - if (allocated(SrcMiscData%F_PtfmAdd)) then - LB(1:1) = lbound(SrcMiscData%F_PtfmAdd) - UB(1:1) = ubound(SrcMiscData%F_PtfmAdd) - if (.not. allocated(DstMiscData%F_PtfmAdd)) then - allocate(DstMiscData%F_PtfmAdd(LB(1):UB(1)), stat=ErrStat2) + DstParamData%PotMod = SrcParamData%PotMod + DstParamData%NBody = SrcParamData%NBody + DstParamData%NBodyMod = SrcParamData%NBodyMod + DstParamData%totalStates = SrcParamData%totalStates + DstParamData%totalExctnStates = SrcParamData%totalExctnStates + DstParamData%totalRdtnStates = SrcParamData%totalRdtnStates + if (allocated(SrcParamData%AddF0)) then + LB(1:2) = lbound(SrcParamData%AddF0) + UB(1:2) = ubound(SrcParamData%AddF0) + if (.not. allocated(DstParamData%AddF0)) then + allocate(DstParamData%AddF0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_PtfmAdd.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddF0.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%F_PtfmAdd = SrcMiscData%F_PtfmAdd + DstParamData%AddF0 = SrcParamData%AddF0 end if - DstMiscData%F_Hydro = SrcMiscData%F_Hydro - if (allocated(SrcMiscData%F_Waves)) then - LB(1:1) = lbound(SrcMiscData%F_Waves) - UB(1:1) = ubound(SrcMiscData%F_Waves) - if (.not. allocated(DstMiscData%F_Waves)) then - allocate(DstMiscData%F_Waves(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%AddCLin)) then + LB(1:3) = lbound(SrcParamData%AddCLin) + UB(1:3) = ubound(SrcParamData%AddCLin) + if (.not. allocated(DstParamData%AddCLin)) then + allocate(DstParamData%AddCLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Waves.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddCLin.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%F_Waves = SrcMiscData%F_Waves + DstParamData%AddCLin = SrcParamData%AddCLin end if - if (allocated(SrcMiscData%WAMIT)) then - LB(1:1) = lbound(SrcMiscData%WAMIT) - UB(1:1) = ubound(SrcMiscData%WAMIT) - if (.not. allocated(DstMiscData%WAMIT)) then - allocate(DstMiscData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%AddBLin)) then + LB(1:3) = lbound(SrcParamData%AddBLin) + UB(1:3) = ubound(SrcParamData%AddBLin) + if (.not. allocated(DstParamData%AddBLin)) then + allocate(DstParamData%AddBLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WAMIT.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddBLin.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call WAMIT_CopyMisc(SrcMiscData%WAMIT(i1), DstMiscData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%AddBLin = SrcParamData%AddBLin end if - if (allocated(SrcMiscData%WAMIT2)) then - LB(1:1) = lbound(SrcMiscData%WAMIT2) - UB(1:1) = ubound(SrcMiscData%WAMIT2) - if (.not. allocated(DstMiscData%WAMIT2)) then - allocate(DstMiscData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%AddBQuad)) then + LB(1:3) = lbound(SrcParamData%AddBQuad) + UB(1:3) = ubound(SrcParamData%AddBQuad) + if (.not. allocated(DstParamData%AddBQuad)) then + allocate(DstParamData%AddBQuad(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WAMIT2.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddBQuad.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call WAMIT2_CopyMisc(SrcMiscData%WAMIT2(i1), DstMiscData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%AddBQuad = SrcParamData%AddBQuad end if - call Morison_CopyMisc(SrcMiscData%Morison, DstMiscData%Morison, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcMiscData%u_WAMIT)) then - LB(1:1) = lbound(SrcMiscData%u_WAMIT) - UB(1:1) = ubound(SrcMiscData%u_WAMIT) - if (.not. allocated(DstMiscData%u_WAMIT)) then - allocate(DstMiscData%u_WAMIT(LB(1):UB(1)), stat=ErrStat2) + DstParamData%DT = SrcParamData%DT + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_WAMIT.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call WAMIT_CopyInput(SrcMiscData%u_WAMIT(i1), DstMiscData%u_WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NumTotalOuts = SrcParamData%NumTotalOuts + DstParamData%OutSwtch = SrcParamData%OutSwtch + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%OutSFmt = SrcParamData%OutSFmt + DstParamData%Delim = SrcParamData%Delim + DstParamData%UnOutFile = SrcParamData%UnOutFile + DstParamData%OutDec = SrcParamData%OutDec + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx + end if + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%du = SrcParamData%du + end if + if (allocated(SrcParamData%dx)) then + LB(1:1) = lbound(SrcParamData%dx) + UB(1:1) = ubound(SrcParamData%dx) + if (.not. allocated(DstParamData%dx)) then + allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dx = SrcParamData%dx + end if + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%VisMeshes = SrcParamData%VisMeshes + DstParamData%WaveField => SrcParamData%WaveField + DstParamData%PtfmYMod = SrcParamData%PtfmYMod + DstParamData%CYawFilt = SrcParamData%CYawFilt end subroutine -subroutine HydroDyn_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(HydroDyn_MiscVarType), intent(inout) :: MiscData +subroutine HydroDyn_DestroyParam(ParamData, ErrStat, ErrMsg) + type(HydroDyn_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'HydroDyn_DestroyMisc' + character(*), parameter :: RoutineName = 'HydroDyn_DestroyParam' ErrStat = ErrID_None ErrMsg = '' - call MeshDestroy( MiscData%AllHdroOrigin, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call HydroDyn_DestroyHD_ModuleMapType(MiscData%HD_MeshMap, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(MiscData%F_PtfmAdd)) then - deallocate(MiscData%F_PtfmAdd) - end if - if (allocated(MiscData%F_Waves)) then - deallocate(MiscData%F_Waves) - end if - if (allocated(MiscData%WAMIT)) then - LB(1:1) = lbound(MiscData%WAMIT) - UB(1:1) = ubound(MiscData%WAMIT) + if (allocated(ParamData%WAMIT)) then + LB(1:1) = lbound(ParamData%WAMIT) + UB(1:1) = ubound(ParamData%WAMIT) do i1 = LB(1), UB(1) - call WAMIT_DestroyMisc(MiscData%WAMIT(i1), ErrStat2, ErrMsg2) + call WAMIT_DestroyParam(ParamData%WAMIT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%WAMIT) - end if - if (allocated(MiscData%WAMIT2)) then - LB(1:1) = lbound(MiscData%WAMIT2) - UB(1:1) = ubound(MiscData%WAMIT2) - do i1 = LB(1), UB(1) - call WAMIT2_DestroyMisc(MiscData%WAMIT2(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%WAMIT2) - end if - call Morison_DestroyMisc(MiscData%Morison, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(MiscData%u_WAMIT)) then - LB(1:1) = lbound(MiscData%u_WAMIT) - UB(1:1) = ubound(MiscData%u_WAMIT) - do i1 = LB(1), UB(1) - call WAMIT_DestroyInput(MiscData%u_WAMIT(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%u_WAMIT) - end if -end subroutine - -subroutine HydroDyn_PackMisc(RF, Indata) - type(RegFile), intent(inout) :: RF - type(HydroDyn_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'HydroDyn_PackMisc' - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - if (RF%ErrStat >= AbortErrLev) return - call MeshPack(RF, InData%AllHdroOrigin) - call HydroDyn_PackHD_ModuleMapType(RF, InData%HD_MeshMap) - call RegPack(RF, InData%Decimate) - call RegPack(RF, InData%LastOutTime) - call RegPackAlloc(RF, InData%F_PtfmAdd) - call RegPack(RF, InData%F_Hydro) - call RegPackAlloc(RF, InData%F_Waves) - call RegPack(RF, allocated(InData%WAMIT)) - if (allocated(InData%WAMIT)) then - call RegPackBounds(RF, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) - LB(1:1) = lbound(InData%WAMIT) - UB(1:1) = ubound(InData%WAMIT) - do i1 = LB(1), UB(1) - call WAMIT_PackMisc(RF, InData%WAMIT(i1)) - end do - end if - call RegPack(RF, allocated(InData%WAMIT2)) - if (allocated(InData%WAMIT2)) then - call RegPackBounds(RF, 1, lbound(InData%WAMIT2), ubound(InData%WAMIT2)) - LB(1:1) = lbound(InData%WAMIT2) - UB(1:1) = ubound(InData%WAMIT2) - do i1 = LB(1), UB(1) - call WAMIT2_PackMisc(RF, InData%WAMIT2(i1)) - end do - end if - call Morison_PackMisc(RF, InData%Morison) - call RegPack(RF, allocated(InData%u_WAMIT)) - if (allocated(InData%u_WAMIT)) then - call RegPackBounds(RF, 1, lbound(InData%u_WAMIT), ubound(InData%u_WAMIT)) - LB(1:1) = lbound(InData%u_WAMIT) - UB(1:1) = ubound(InData%u_WAMIT) - do i1 = LB(1), UB(1) - call WAMIT_PackInput(RF, InData%u_WAMIT(i1)) - end do - end if - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine HydroDyn_UnPackMisc(RF, OutData) - type(RegFile), intent(inout) :: RF - type(HydroDyn_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'HydroDyn_UnPackMisc' - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call MeshUnpack(RF, OutData%AllHdroOrigin) ! AllHdroOrigin - call HydroDyn_UnpackHD_ModuleMapType(RF, OutData%HD_MeshMap) ! HD_MeshMap - call RegUnpack(RF, OutData%Decimate); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%F_PtfmAdd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%F_Hydro); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%F_Waves); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call WAMIT_UnpackMisc(RF, OutData%WAMIT(i1)) ! WAMIT - end do - end if - if (allocated(OutData%WAMIT2)) deallocate(OutData%WAMIT2) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%WAMIT2(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call WAMIT2_UnpackMisc(RF, OutData%WAMIT2(i1)) ! WAMIT2 - end do - end if - call Morison_UnpackMisc(RF, OutData%Morison) ! Morison - if (allocated(OutData%u_WAMIT)) deallocate(OutData%u_WAMIT) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_WAMIT(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_WAMIT.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call WAMIT_UnpackInput(RF, OutData%u_WAMIT(i1)) ! u_WAMIT - end do - end if -end subroutine - -subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) - type(HydroDyn_ParameterType), intent(in) :: SrcParamData - type(HydroDyn_ParameterType), intent(inout) :: DstParamData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2, i3 - integer(B4Ki) :: LB(3), UB(3) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'HydroDyn_CopyParam' - ErrStat = ErrID_None - ErrMsg = '' - DstParamData%nWAMITObj = SrcParamData%nWAMITObj - DstParamData%vecMultiplier = SrcParamData%vecMultiplier - if (allocated(SrcParamData%WAMIT)) then - LB(1:1) = lbound(SrcParamData%WAMIT) - UB(1:1) = ubound(SrcParamData%WAMIT) - if (.not. allocated(DstParamData%WAMIT)) then - allocate(DstParamData%WAMIT(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WAMIT.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call WAMIT_CopyParam(SrcParamData%WAMIT(i1), DstParamData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcParamData%WAMIT2)) then - LB(1:1) = lbound(SrcParamData%WAMIT2) - UB(1:1) = ubound(SrcParamData%WAMIT2) - if (.not. allocated(DstParamData%WAMIT2)) then - allocate(DstParamData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WAMIT2.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call WAMIT2_CopyParam(SrcParamData%WAMIT2(i1), DstParamData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - DstParamData%WAMIT2used = SrcParamData%WAMIT2used - call Morison_CopyParam(SrcParamData%Morison, DstParamData%Morison, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - DstParamData%PotMod = SrcParamData%PotMod - DstParamData%NBody = SrcParamData%NBody - DstParamData%NBodyMod = SrcParamData%NBodyMod - DstParamData%totalStates = SrcParamData%totalStates - DstParamData%totalExctnStates = SrcParamData%totalExctnStates - DstParamData%totalRdtnStates = SrcParamData%totalRdtnStates - if (allocated(SrcParamData%AddF0)) then - LB(1:2) = lbound(SrcParamData%AddF0) - UB(1:2) = ubound(SrcParamData%AddF0) - if (.not. allocated(DstParamData%AddF0)) then - allocate(DstParamData%AddF0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddF0.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%AddF0 = SrcParamData%AddF0 - end if - if (allocated(SrcParamData%AddCLin)) then - LB(1:3) = lbound(SrcParamData%AddCLin) - UB(1:3) = ubound(SrcParamData%AddCLin) - if (.not. allocated(DstParamData%AddCLin)) then - allocate(DstParamData%AddCLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddCLin.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%AddCLin = SrcParamData%AddCLin - end if - if (allocated(SrcParamData%AddBLin)) then - LB(1:3) = lbound(SrcParamData%AddBLin) - UB(1:3) = ubound(SrcParamData%AddBLin) - if (.not. allocated(DstParamData%AddBLin)) then - allocate(DstParamData%AddBLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddBLin.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%AddBLin = SrcParamData%AddBLin - end if - if (allocated(SrcParamData%AddBQuad)) then - LB(1:3) = lbound(SrcParamData%AddBQuad) - UB(1:3) = ubound(SrcParamData%AddBQuad) - if (.not. allocated(DstParamData%AddBQuad)) then - allocate(DstParamData%AddBQuad(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddBQuad.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%AddBQuad = SrcParamData%AddBQuad - end if - DstParamData%DT = SrcParamData%DT - if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam) - UB(1:1) = ubound(SrcParamData%OutParam) - if (.not. allocated(DstParamData%OutParam)) then - allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%NumTotalOuts = SrcParamData%NumTotalOuts - DstParamData%OutSwtch = SrcParamData%OutSwtch - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutSFmt = SrcParamData%OutSFmt - DstParamData%Delim = SrcParamData%Delim - DstParamData%UnOutFile = SrcParamData%UnOutFile - DstParamData%OutDec = SrcParamData%OutDec - if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx) - UB(1:2) = ubound(SrcParamData%Jac_u_indx) - if (.not. allocated(DstParamData%Jac_u_indx)) then - allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx - end if - if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du) - UB(1:1) = ubound(SrcParamData%du) - if (.not. allocated(DstParamData%du)) then - allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%du = SrcParamData%du - end if - if (allocated(SrcParamData%dx)) then - LB(1:1) = lbound(SrcParamData%dx) - UB(1:1) = ubound(SrcParamData%dx) - if (.not. allocated(DstParamData%dx)) then - allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%dx = SrcParamData%dx - end if - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%VisMeshes = SrcParamData%VisMeshes - DstParamData%WaveField => SrcParamData%WaveField - DstParamData%PtfmYMod = SrcParamData%PtfmYMod - DstParamData%CYawFilt = SrcParamData%CYawFilt -end subroutine - -subroutine HydroDyn_DestroyParam(ParamData, ErrStat, ErrMsg) - type(HydroDyn_ParameterType), intent(inout) :: ParamData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2, i3 - integer(B4Ki) :: LB(3), UB(3) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'HydroDyn_DestroyParam' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(ParamData%WAMIT)) then - LB(1:1) = lbound(ParamData%WAMIT) - UB(1:1) = ubound(ParamData%WAMIT) - do i1 = LB(1), UB(1) - call WAMIT_DestroyParam(ParamData%WAMIT(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ParamData%WAMIT) + deallocate(ParamData%WAMIT) end if if (allocated(ParamData%WAMIT2)) then LB(1:1) = lbound(ParamData%WAMIT2) @@ -2056,104 +1839,363 @@ subroutine HydroDyn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, if (.not. allocated(DstOutputData%WAMIT)) then allocate(DstOutputData%WAMIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAMIT.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyOutput(SrcOutputData%WAMIT(i1), DstOutputData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOutputData%WAMIT2)) then + LB(1:1) = lbound(SrcOutputData%WAMIT2) + UB(1:1) = ubound(SrcOutputData%WAMIT2) + if (.not. allocated(DstOutputData%WAMIT2)) then + allocate(DstOutputData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAMIT2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT2_CopyOutput(SrcOutputData%WAMIT2(i1), DstOutputData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call Morison_CopyOutput(SrcOutputData%Morison, DstOutputData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%WAMITMesh, DstOutputData%WAMITMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + end if +end subroutine + +subroutine HydroDyn_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(HydroDyn_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WAMIT)) then + LB(1:1) = lbound(OutputData%WAMIT) + UB(1:1) = ubound(OutputData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyOutput(OutputData%WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%WAMIT) + end if + if (allocated(OutputData%WAMIT2)) then + LB(1:1) = lbound(OutputData%WAMIT2) + UB(1:1) = ubound(OutputData%WAMIT2) + do i1 = LB(1), UB(1) + call WAMIT2_DestroyOutput(OutputData%WAMIT2(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%WAMIT2) + end if + call Morison_DestroyOutput(OutputData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%WAMITMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine HydroDyn_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(HydroDyn_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%WAMIT)) + if (allocated(InData%WAMIT)) then + call RegPackBounds(RF, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_PackOutput(RF, InData%WAMIT(i1)) + end do + end if + call RegPack(RF, allocated(InData%WAMIT2)) + if (allocated(InData%WAMIT2)) then + call RegPackBounds(RF, 1, lbound(InData%WAMIT2), ubound(InData%WAMIT2)) + LB(1:1) = lbound(InData%WAMIT2) + UB(1:1) = ubound(InData%WAMIT2) + do i1 = LB(1), UB(1) + call WAMIT2_PackOutput(RF, InData%WAMIT2(i1)) + end do + end if + call Morison_PackOutput(RF, InData%Morison) + call MeshPack(RF, InData%WAMITMesh) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(HydroDyn_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackOutput(RF, OutData%WAMIT(i1)) ! WAMIT + end do + end if + if (allocated(OutData%WAMIT2)) deallocate(OutData%WAMIT2) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%WAMIT2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT2_UnpackOutput(RF, OutData%WAMIT2(i1)) ! WAMIT2 + end do + end if + call Morison_UnpackOutput(RF, OutData%Morison) ! Morison + call MeshUnpack(RF, OutData%WAMITMesh) ! WAMITMesh + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_MiscVarType), intent(inout) :: SrcMiscData + type(HydroDyn_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcMiscData%AllHdroOrigin, DstMiscData%AllHdroOrigin, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyHD_ModuleMapType(SrcMiscData%HD_MeshMap, DstMiscData%HD_MeshMap, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%Decimate = SrcMiscData%Decimate + DstMiscData%LastOutTime = SrcMiscData%LastOutTime + if (allocated(SrcMiscData%F_PtfmAdd)) then + LB(1:1) = lbound(SrcMiscData%F_PtfmAdd) + UB(1:1) = ubound(SrcMiscData%F_PtfmAdd) + if (.not. allocated(DstMiscData%F_PtfmAdd)) then + allocate(DstMiscData%F_PtfmAdd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_PtfmAdd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_PtfmAdd = SrcMiscData%F_PtfmAdd + end if + DstMiscData%F_Hydro = SrcMiscData%F_Hydro + if (allocated(SrcMiscData%F_Waves)) then + LB(1:1) = lbound(SrcMiscData%F_Waves) + UB(1:1) = ubound(SrcMiscData%F_Waves) + if (.not. allocated(DstMiscData%F_Waves)) then + allocate(DstMiscData%F_Waves(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Waves.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_Waves = SrcMiscData%F_Waves + end if + if (allocated(SrcMiscData%WAMIT)) then + LB(1:1) = lbound(SrcMiscData%WAMIT) + UB(1:1) = ubound(SrcMiscData%WAMIT) + if (.not. allocated(DstMiscData%WAMIT)) then + allocate(DstMiscData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WAMIT.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call WAMIT_CopyOutput(SrcOutputData%WAMIT(i1), DstOutputData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call WAMIT_CopyMisc(SrcMiscData%WAMIT(i1), DstMiscData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcOutputData%WAMIT2)) then - LB(1:1) = lbound(SrcOutputData%WAMIT2) - UB(1:1) = ubound(SrcOutputData%WAMIT2) - if (.not. allocated(DstOutputData%WAMIT2)) then - allocate(DstOutputData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%WAMIT2)) then + LB(1:1) = lbound(SrcMiscData%WAMIT2) + UB(1:1) = ubound(SrcMiscData%WAMIT2) + if (.not. allocated(DstMiscData%WAMIT2)) then + allocate(DstMiscData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAMIT2.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WAMIT2.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call WAMIT2_CopyOutput(SrcOutputData%WAMIT2(i1), DstOutputData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2) + call WAMIT2_CopyMisc(SrcMiscData%WAMIT2(i1), DstMiscData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - call Morison_CopyOutput(SrcOutputData%Morison, DstOutputData%Morison, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcOutputData%WAMITMesh, DstOutputData%WAMITMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call Morison_CopyMisc(SrcMiscData%Morison, DstMiscData%Morison, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) - if (.not. allocated(DstOutputData%WriteOutput)) then - allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%u_WAMIT)) then + LB(1:1) = lbound(SrcMiscData%u_WAMIT) + UB(1:1) = ubound(SrcMiscData%u_WAMIT) + if (.not. allocated(DstMiscData%u_WAMIT)) then + allocate(DstMiscData%u_WAMIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_WAMIT.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%WriteOutput = SrcOutputData%WriteOutput + do i1 = LB(1), UB(1) + call WAMIT_CopyInput(SrcMiscData%u_WAMIT(i1), DstMiscData%u_WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if end subroutine -subroutine HydroDyn_DestroyOutput(OutputData, ErrStat, ErrMsg) - type(HydroDyn_OutputType), intent(inout) :: OutputData +subroutine HydroDyn_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(HydroDyn_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg integer(B4Ki) :: i1 integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'HydroDyn_DestroyOutput' + character(*), parameter :: RoutineName = 'HydroDyn_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' - if (allocated(OutputData%WAMIT)) then - LB(1:1) = lbound(OutputData%WAMIT) - UB(1:1) = ubound(OutputData%WAMIT) + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( MiscData%AllHdroOrigin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyHD_ModuleMapType(MiscData%HD_MeshMap, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%F_PtfmAdd)) then + deallocate(MiscData%F_PtfmAdd) + end if + if (allocated(MiscData%F_Waves)) then + deallocate(MiscData%F_Waves) + end if + if (allocated(MiscData%WAMIT)) then + LB(1:1) = lbound(MiscData%WAMIT) + UB(1:1) = ubound(MiscData%WAMIT) do i1 = LB(1), UB(1) - call WAMIT_DestroyOutput(OutputData%WAMIT(i1), ErrStat2, ErrMsg2) + call WAMIT_DestroyMisc(MiscData%WAMIT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(OutputData%WAMIT) + deallocate(MiscData%WAMIT) end if - if (allocated(OutputData%WAMIT2)) then - LB(1:1) = lbound(OutputData%WAMIT2) - UB(1:1) = ubound(OutputData%WAMIT2) + if (allocated(MiscData%WAMIT2)) then + LB(1:1) = lbound(MiscData%WAMIT2) + UB(1:1) = ubound(MiscData%WAMIT2) do i1 = LB(1), UB(1) - call WAMIT2_DestroyOutput(OutputData%WAMIT2(i1), ErrStat2, ErrMsg2) + call WAMIT2_DestroyMisc(MiscData%WAMIT2(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(OutputData%WAMIT2) + deallocate(MiscData%WAMIT2) end if - call Morison_DestroyOutput(OutputData%Morison, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( OutputData%WAMITMesh, ErrStat2, ErrMsg2) + call Morison_DestroyMisc(MiscData%Morison, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(OutputData%WriteOutput)) then - deallocate(OutputData%WriteOutput) + if (allocated(MiscData%u_WAMIT)) then + LB(1:1) = lbound(MiscData%u_WAMIT) + UB(1:1) = ubound(MiscData%u_WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyInput(MiscData%u_WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%u_WAMIT) end if end subroutine -subroutine HydroDyn_PackOutput(RF, Indata) +subroutine HydroDyn_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF - type(HydroDyn_OutputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'HydroDyn_PackOutput' + type(HydroDyn_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackMisc' integer(B4Ki) :: i1 integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackModJacType(RF, InData%Jac) + call HydroDyn_PackContState(RF, InData%x_perturb) + call HydroDyn_PackInput(RF, InData%u_perturb) + call HydroDyn_PackContState(RF, InData%dxdt_lin) + call HydroDyn_PackOutput(RF, InData%y_lin) + call MeshPack(RF, InData%AllHdroOrigin) + call HydroDyn_PackHD_ModuleMapType(RF, InData%HD_MeshMap) + call RegPack(RF, InData%Decimate) + call RegPack(RF, InData%LastOutTime) + call RegPackAlloc(RF, InData%F_PtfmAdd) + call RegPack(RF, InData%F_Hydro) + call RegPackAlloc(RF, InData%F_Waves) call RegPack(RF, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then call RegPackBounds(RF, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) LB(1:1) = lbound(InData%WAMIT) UB(1:1) = ubound(InData%WAMIT) do i1 = LB(1), UB(1) - call WAMIT_PackOutput(RF, InData%WAMIT(i1)) + call WAMIT_PackMisc(RF, InData%WAMIT(i1)) end do end if call RegPack(RF, allocated(InData%WAMIT2)) @@ -2162,24 +2204,43 @@ subroutine HydroDyn_PackOutput(RF, Indata) LB(1:1) = lbound(InData%WAMIT2) UB(1:1) = ubound(InData%WAMIT2) do i1 = LB(1), UB(1) - call WAMIT2_PackOutput(RF, InData%WAMIT2(i1)) + call WAMIT2_PackMisc(RF, InData%WAMIT2(i1)) + end do + end if + call Morison_PackMisc(RF, InData%Morison) + call RegPack(RF, allocated(InData%u_WAMIT)) + if (allocated(InData%u_WAMIT)) then + call RegPackBounds(RF, 1, lbound(InData%u_WAMIT), ubound(InData%u_WAMIT)) + LB(1:1) = lbound(InData%u_WAMIT) + UB(1:1) = ubound(InData%u_WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_PackInput(RF, InData%u_WAMIT(i1)) end do end if - call Morison_PackOutput(RF, InData%Morison) - call MeshPack(RF, InData%WAMITMesh) - call RegPackAlloc(RF, InData%WriteOutput) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine HydroDyn_UnPackOutput(RF, OutData) +subroutine HydroDyn_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF - type(HydroDyn_OutputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'HydroDyn_UnPackOutput' + type(HydroDyn_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackMisc' integer(B4Ki) :: i1 integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call HydroDyn_UnpackContState(RF, OutData%x_perturb) ! x_perturb + call HydroDyn_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call HydroDyn_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin + call HydroDyn_UnpackOutput(RF, OutData%y_lin) ! y_lin + call MeshUnpack(RF, OutData%AllHdroOrigin) ! AllHdroOrigin + call HydroDyn_UnpackHD_ModuleMapType(RF, OutData%HD_MeshMap) ! HD_MeshMap + call RegUnpack(RF, OutData%Decimate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_PtfmAdd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%F_Hydro); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_Waves); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -2190,7 +2251,7 @@ subroutine HydroDyn_UnPackOutput(RF, OutData) return end if do i1 = LB(1), UB(1) - call WAMIT_UnpackOutput(RF, OutData%WAMIT(i1)) ! WAMIT + call WAMIT_UnpackMisc(RF, OutData%WAMIT(i1)) ! WAMIT end do end if if (allocated(OutData%WAMIT2)) deallocate(OutData%WAMIT2) @@ -2203,12 +2264,23 @@ subroutine HydroDyn_UnPackOutput(RF, OutData) return end if do i1 = LB(1), UB(1) - call WAMIT2_UnpackOutput(RF, OutData%WAMIT2(i1)) ! WAMIT2 + call WAMIT2_UnpackMisc(RF, OutData%WAMIT2(i1)) ! WAMIT2 + end do + end if + call Morison_UnpackMisc(RF, OutData%Morison) ! Morison + if (allocated(OutData%u_WAMIT)) deallocate(OutData%u_WAMIT) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_WAMIT.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackInput(RF, OutData%u_WAMIT(i1)) ! u_WAMIT end do end if - call Morison_UnpackOutput(RF, OutData%Morison) ! Morison - call MeshUnpack(RF, OutData%WAMITMesh) ! WAMITMesh - call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine HydroDyn_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) @@ -2568,5 +2640,389 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSta y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function HydroDyn_InputMeshPointer(u, DL) result(Mesh) + type(HydroDyn_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (HydroDyn_u_Morison_Mesh) + Mesh => u%Morison%Mesh + case (HydroDyn_u_WAMITMesh) + Mesh => u%WAMITMesh + case (HydroDyn_u_PRPMesh) + Mesh => u%PRPMesh + end select +end function + +function HydroDyn_OutputMeshPointer(y, DL) result(Mesh) + type(HydroDyn_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (HydroDyn_y_WAMIT_Mesh) + Mesh => y%WAMIT(DL%i1)%Mesh + case (HydroDyn_y_WAMIT2_Mesh) + Mesh => y%WAMIT2(DL%i1)%Mesh + case (HydroDyn_y_Morison_Mesh) + Mesh => y%Morison%Mesh + case (HydroDyn_y_Morison_VisMesh) + Mesh => y%Morison%VisMesh + case (HydroDyn_y_WAMITMesh) + Mesh => y%WAMITMesh + end select +end function + +subroutine HydroDyn_VarsPackContState(Vars, x, ValAry) + type(HydroDyn_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call HydroDyn_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine HydroDyn_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(HydroDyn_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (HydroDyn_x_WAMIT_SS_Rdtn_x) + VarVals = x%WAMIT(DL%i1)%SS_Rdtn%x(V%iLB:V%iUB) ! Rank 1 Array + case (HydroDyn_x_WAMIT_SS_Exctn_x) + VarVals = x%WAMIT(DL%i1)%SS_Exctn%x(V%iLB:V%iUB) ! Rank 1 Array + case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) + VarVals(1) = x%WAMIT(DL%i1)%Conv_Rdtn%DummyContState ! Scalar + case (HydroDyn_x_Morison_DummyContState) + VarVals(1) = x%Morison%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine HydroDyn_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(HydroDyn_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call HydroDyn_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine HydroDyn_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(HydroDyn_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (HydroDyn_x_WAMIT_SS_Rdtn_x) + x%WAMIT(DL%i1)%SS_Rdtn%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (HydroDyn_x_WAMIT_SS_Exctn_x) + x%WAMIT(DL%i1)%SS_Exctn%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) + x%WAMIT(DL%i1)%Conv_Rdtn%DummyContState = VarVals(1) ! Scalar + case (HydroDyn_x_Morison_DummyContState) + x%Morison%DummyContState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function HydroDyn_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (HydroDyn_x_WAMIT_SS_Rdtn_x) + Name = "x%WAMIT("//trim(Num2LStr(DL%i1))//")%SS_Rdtn%x" + case (HydroDyn_x_WAMIT_SS_Exctn_x) + Name = "x%WAMIT("//trim(Num2LStr(DL%i1))//")%SS_Exctn%x" + case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) + Name = "x%WAMIT("//trim(Num2LStr(DL%i1))//")%Conv_Rdtn%DummyContState" + case (HydroDyn_x_Morison_DummyContState) + Name = "x%Morison%DummyContState" + case default + Name = "Unknown Field" + end select +end function + +subroutine HydroDyn_VarsPackContStateDeriv(Vars, x, ValAry) + type(HydroDyn_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call HydroDyn_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine HydroDyn_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(HydroDyn_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (HydroDyn_x_WAMIT_SS_Rdtn_x) + VarVals = x%WAMIT(DL%i1)%SS_Rdtn%x(V%iLB:V%iUB) ! Rank 1 Array + case (HydroDyn_x_WAMIT_SS_Exctn_x) + VarVals = x%WAMIT(DL%i1)%SS_Exctn%x(V%iLB:V%iUB) ! Rank 1 Array + case (HydroDyn_x_WAMIT_Conv_Rdtn_DummyContState) + VarVals(1) = x%WAMIT(DL%i1)%Conv_Rdtn%DummyContState ! Scalar + case (HydroDyn_x_Morison_DummyContState) + VarVals(1) = x%Morison%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine HydroDyn_VarsPackConstrState(Vars, z, ValAry) + type(HydroDyn_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call HydroDyn_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine HydroDyn_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(HydroDyn_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (HydroDyn_z_WAMIT_Conv_Rdtn_DummyConstrState) + VarVals(1) = z%WAMIT%Conv_Rdtn%DummyConstrState ! Scalar + case (HydroDyn_z_WAMIT_SS_Rdtn_DummyConstrState) + VarVals(1) = z%WAMIT%SS_Rdtn%DummyConstrState ! Scalar + case (HydroDyn_z_WAMIT_SS_Exctn_DummyConstrState) + VarVals(1) = z%WAMIT%SS_Exctn%DummyConstrState ! Scalar + case (HydroDyn_z_Morison_DummyConstrState) + VarVals(1) = z%Morison%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine HydroDyn_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(HydroDyn_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call HydroDyn_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine HydroDyn_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(HydroDyn_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (HydroDyn_z_WAMIT_Conv_Rdtn_DummyConstrState) + z%WAMIT%Conv_Rdtn%DummyConstrState = VarVals(1) ! Scalar + case (HydroDyn_z_WAMIT_SS_Rdtn_DummyConstrState) + z%WAMIT%SS_Rdtn%DummyConstrState = VarVals(1) ! Scalar + case (HydroDyn_z_WAMIT_SS_Exctn_DummyConstrState) + z%WAMIT%SS_Exctn%DummyConstrState = VarVals(1) ! Scalar + case (HydroDyn_z_Morison_DummyConstrState) + z%Morison%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function HydroDyn_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (HydroDyn_z_WAMIT_Conv_Rdtn_DummyConstrState) + Name = "z%WAMIT%Conv_Rdtn%DummyConstrState" + case (HydroDyn_z_WAMIT_SS_Rdtn_DummyConstrState) + Name = "z%WAMIT%SS_Rdtn%DummyConstrState" + case (HydroDyn_z_WAMIT_SS_Exctn_DummyConstrState) + Name = "z%WAMIT%SS_Exctn%DummyConstrState" + case (HydroDyn_z_Morison_DummyConstrState) + Name = "z%Morison%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine HydroDyn_VarsPackInput(Vars, u, ValAry) + type(HydroDyn_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call HydroDyn_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine HydroDyn_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(HydroDyn_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (HydroDyn_u_Morison_Mesh) + call MV_PackMesh(V, u%Morison%Mesh, ValAry) ! Mesh + case (HydroDyn_u_Morison_PtfmRefY) + VarVals(1) = u%Morison%PtfmRefY ! Scalar + case (HydroDyn_u_WAMITMesh) + call MV_PackMesh(V, u%WAMITMesh, ValAry) ! Mesh + case (HydroDyn_u_PRPMesh) + call MV_PackMesh(V, u%PRPMesh, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine HydroDyn_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(HydroDyn_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call HydroDyn_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine HydroDyn_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(HydroDyn_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (HydroDyn_u_Morison_Mesh) + call MV_UnpackMesh(V, ValAry, u%Morison%Mesh) ! Mesh + case (HydroDyn_u_Morison_PtfmRefY) + u%Morison%PtfmRefY = VarVals(1) ! Scalar + case (HydroDyn_u_WAMITMesh) + call MV_UnpackMesh(V, ValAry, u%WAMITMesh) ! Mesh + case (HydroDyn_u_PRPMesh) + call MV_UnpackMesh(V, ValAry, u%PRPMesh) ! Mesh + end select + end associate +end subroutine + +function HydroDyn_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (HydroDyn_u_Morison_Mesh) + Name = "u%Morison%Mesh" + case (HydroDyn_u_Morison_PtfmRefY) + Name = "u%Morison%PtfmRefY" + case (HydroDyn_u_WAMITMesh) + Name = "u%WAMITMesh" + case (HydroDyn_u_PRPMesh) + Name = "u%PRPMesh" + case default + Name = "Unknown Field" + end select +end function + +subroutine HydroDyn_VarsPackOutput(Vars, y, ValAry) + type(HydroDyn_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call HydroDyn_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine HydroDyn_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(HydroDyn_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (HydroDyn_y_WAMIT_Mesh) + call MV_PackMesh(V, y%WAMIT(DL%i1)%Mesh, ValAry) ! Mesh + case (HydroDyn_y_WAMIT2_Mesh) + call MV_PackMesh(V, y%WAMIT2(DL%i1)%Mesh, ValAry) ! Mesh + case (HydroDyn_y_Morison_Mesh) + call MV_PackMesh(V, y%Morison%Mesh, ValAry) ! Mesh + case (HydroDyn_y_Morison_VisMesh) + call MV_PackMesh(V, y%Morison%VisMesh, ValAry) ! Mesh + case (HydroDyn_y_Morison_WriteOutput) + VarVals = y%Morison%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case (HydroDyn_y_WAMITMesh) + call MV_PackMesh(V, y%WAMITMesh, ValAry) ! Mesh + case (HydroDyn_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine HydroDyn_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(HydroDyn_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call HydroDyn_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine HydroDyn_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(HydroDyn_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (HydroDyn_y_WAMIT_Mesh) + call MV_UnpackMesh(V, ValAry, y%WAMIT(DL%i1)%Mesh) ! Mesh + case (HydroDyn_y_WAMIT2_Mesh) + call MV_UnpackMesh(V, ValAry, y%WAMIT2(DL%i1)%Mesh) ! Mesh + case (HydroDyn_y_Morison_Mesh) + call MV_UnpackMesh(V, ValAry, y%Morison%Mesh) ! Mesh + case (HydroDyn_y_Morison_VisMesh) + call MV_UnpackMesh(V, ValAry, y%Morison%VisMesh) ! Mesh + case (HydroDyn_y_Morison_WriteOutput) + y%Morison%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (HydroDyn_y_WAMITMesh) + call MV_UnpackMesh(V, ValAry, y%WAMITMesh) ! Mesh + case (HydroDyn_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function HydroDyn_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (HydroDyn_y_WAMIT_Mesh) + Name = "y%WAMIT("//trim(Num2LStr(DL%i1))//")%Mesh" + case (HydroDyn_y_WAMIT2_Mesh) + Name = "y%WAMIT2("//trim(Num2LStr(DL%i1))//")%Mesh" + case (HydroDyn_y_Morison_Mesh) + Name = "y%Morison%Mesh" + case (HydroDyn_y_Morison_VisMesh) + Name = "y%Morison%VisMesh" + case (HydroDyn_y_Morison_WriteOutput) + Name = "y%Morison%WriteOutput" + case (HydroDyn_y_WAMITMesh) + Name = "y%WAMITMesh" + case (HydroDyn_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE HydroDyn_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 2926f82e6b..5610665b29 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -2605,7 +2605,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, !=============================================================================================== ! Calculate the fluid kinematics at all mesh nodes and store for use in the equations below - CALL WaveField_GetWaveKin( p%WaveField, m%WaveField_m, Time, m%DispNodePosHdn, .FALSE., m%nodeInWater, m%WaveElev1, m%WaveElev2, m%WaveElev, m%FDynP, m%FV, m%FA, m%FAMCF, ErrStat2, ErrMsg2 ) + CALL WaveField_GetWaveKin( p%WaveField, m%WaveField_m, Time, m%DispNodePosHdn, .FALSE., .TRUE., m%nodeInWater, m%WaveElev1, m%WaveElev2, m%WaveElev, m%FDynP, m%FV, m%FA, m%FAMCF, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Compute fluid velocity relative to the structure DO j = 1, p%NNodes @@ -2625,8 +2625,8 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ! Loop through each member DO im = 1, p%NMembers - N = p%Members(im)%NElements mem = p%Members(im) + N = mem%NElements call YawMember(mem, u%PtfmRefY, ErrStat2, ErrMsg2) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -2761,7 +2761,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, Zeta2 = 0.0_ReKi END IF Is1stElement = ( i .EQ. 1) - CALL getElementHstLds_Mod1( Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1b, r2b, dl, mem%alpha(i), Is1stElement, F_B0, F_B1, F_B2, ErrStat2, ErrMsg2 ) + CALL getElementHstLds_Mod1(mem, Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1b, r2b, dl, mem%alpha(i), Is1stElement, F_B0, F_B1, F_B2, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Add nodal loads to mesh IF ( .NOT. Is1stElement ) THEN @@ -3047,7 +3047,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ! Compute the distributed loads at the point of intersection between the member and the free surface ! !----------------------------------------------------------------------------------------------------! ! Get wave kinematics at the free-surface intersection. Set forceNodeInWater=.TRUE. to guarantee the free-surface intersection is in water. - CALL WaveField_GetNodeWaveKin( p%WaveField, m%WaveField_m, Time, FSInt, .TRUE., nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveKin( p%WaveField, m%WaveField_m, Time, FSInt, .TRUE., .TRUE., nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FDynPFSInt = REAL(FDynP,ReKi) FVFSInt = REAL(FV, ReKi) @@ -3607,7 +3607,7 @@ END SUBROUTINE GetTotalWaveElev SUBROUTINE GetFreeSurfaceNormal( Time, pos, r, n, ErrStat, ErrMsg) REAL(DbKi), INTENT( In ) :: Time - REAL(ReKi), INTENT( In ) :: pos(*) ! Position at which free-surface normal is to be calculated. Third entry ignored if present. + REAL(ReKi), INTENT( In ) :: pos(:) ! Position at which free-surface normal is to be calculated. Third entry ignored if present. REAL(ReKi), INTENT( In ) :: r ! Distance for central differencing REAL(ReKi), INTENT( OUT ) :: n(3) ! Free-surface normal vector INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation @@ -3623,7 +3623,7 @@ SUBROUTINE GetFreeSurfaceNormal( Time, pos, r, n, ErrStat, ErrMsg) END SUBROUTINE GetFreeSurfaceNormal - SUBROUTINE GetSectionUnitVectors( k, y, z ) + PURE SUBROUTINE GetSectionUnitVectors( k, y, z ) REAL(ReKi), INTENT( In ) :: k(3) ! Member axial unit vector REAL(ReKi), INTENT( OUT ) :: y(3) ! Horizontal unit vector perpendicular to k REAL(ReKi), INTENT( OUT ) :: z(3) ! Unit vector perpendicular to k and y with positive vertical component @@ -3640,7 +3640,7 @@ SUBROUTINE GetSectionUnitVectors( k, y, z ) END IF END SUBROUTINE GetSectionUnitVectors - SUBROUTINE GetSectionFreeSurfaceIntersects( pos0, FSPt, k_hat, y_hat, z_hat, n_hat, R, theta1, theta2, secStat) + PURE SUBROUTINE GetSectionFreeSurfaceIntersects( pos0, FSPt, k_hat, y_hat, z_hat, n_hat, R, theta1, theta2, secStat) REAL(DbKi), INTENT( In ) :: pos0(3) REAL(DbKi), INTENT( In ) :: FSPt(3) REAL(ReKi), INTENT( In ) :: k_hat(3) @@ -3688,7 +3688,7 @@ SUBROUTINE GetSectionFreeSurfaceIntersects( pos0, FSPt, k_hat, y_hat, z_hat, n_h END SUBROUTINE GetSectionFreeSurfaceIntersects - SUBROUTINE GetSectionHstLds( origin, pos0, k_hat, y_hat, z_hat, R, dRdl, theta1, theta2, dFdl) + PURE SUBROUTINE GetSectionHstLds( origin, pos0, k_hat, y_hat, z_hat, R, dRdl, theta1, theta2, dFdl) REAL(DbKi), INTENT( IN ) :: origin(3) REAL(DbKi), INTENT( IN ) :: pos0(3) @@ -3898,7 +3898,7 @@ RECURSIVE SUBROUTINE RefineElementHstLds( origin, pos1, posMid, pos2, FSPt, r1, END SUBROUTINE RefineElementHstLds - SUBROUTINE GetEndPlateHstLds(pos0, k_hat, y_hat, z_hat, R, theta1, theta2, F) + PURE SUBROUTINE GetEndPlateHstLds(pos0, k_hat, y_hat, z_hat, R, theta1, theta2, F) REAL(ReKi), INTENT( IN ) :: pos0(3) REAL(ReKi), INTENT( IN ) :: k_hat(3) @@ -3964,8 +3964,9 @@ SUBROUTINE GetEndPlateHstLds(pos0, k_hat, y_hat, z_hat, R, theta1, theta2, F) END SUBROUTINE GetEndPlateHstLds - SUBROUTINE getElementHstLds_Mod1( Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1, r2, dl, alphaIn, Is1stElement, F_B0, F_B1, F_B2, ErrStat, ErrMsg ) + SUBROUTINE getElementHstLds_Mod1( mem, Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1, r2, dl, alphaIn, Is1stElement, F_B0, F_B1, F_B2, ErrStat, ErrMsg ) + TYPE(Morison_MemberType), intent(in) :: mem REAL(DbKi), INTENT( IN ) :: Time REAL(ReKi), INTENT( IN ) :: pos1(3) REAL(ReKi), INTENT( IN ) :: pos2(3) @@ -4196,7 +4197,7 @@ subroutine LumpDistrHydroLoads( f_hydro, k_hat, dl, h_c, lumpedLoad ) end subroutine LumpDistrHydroLoads !---------------------------------------------------------------------------------------------------------------------------------- ! Takes loads on node i in element tilted frame and converts to 6DOF loads at node i and adjacent node -SUBROUTINE DistributeElementLoads(Fl, Fr, M, sinPhi, cosPhi, SinBeta, cosBeta, alpha, F1, F2) +PURE SUBROUTINE DistributeElementLoads(Fl, Fr, M, sinPhi, cosPhi, SinBeta, cosBeta, alpha, F1, F2) REAL(ReKi), INTENT ( IN ) :: Fl ! (N) axial load about node i REAL(ReKi), INTENT ( IN ) :: Fr ! (N) radial load about node i in direction of tilt @@ -4209,25 +4210,22 @@ SUBROUTINE DistributeElementLoads(Fl, Fr, M, sinPhi, cosPhi, SinBeta, cosBeta, a REAL(ReKi), INTENT ( OUT ) :: F1(6) ! (N, Nm) force/moment vector for node i REAL(ReKi), INTENT ( OUT ) :: F2(6) ! (N, Nm) force/moment vector for the other node (whether i+1, or i-1) + REAL(ReKi) :: F(6) - F1(1) = cosBeta*(Fl*sinPhi + Fr*cosPhi)*alpha - F1(2) = sinBeta*(Fl*sinPhi + Fr*cosPhi)*alpha - F1(3) = (Fl*cosPhi - Fr*sinPhi)*alpha - F1(4) = -sinBeta * M *alpha - F1(5) = cosBeta * M *alpha - F1(6) = 0.0 - - F2(1) = cosBeta*(Fl*sinPhi + Fr*cosPhi)*(1-alpha) - F2(2) = sinBeta*(Fl*sinPhi + Fr*cosPhi)*(1-alpha) - F2(3) = (Fl*cosPhi - Fr*sinPhi)*(1-alpha) - F2(4) = -sinBeta * M *(1-alpha) - F2(5) = cosBeta * M *(1-alpha) - F2(6) = 0.0 + F(1) = cosBeta*(Fl*sinPhi + Fr*cosPhi) + F(2) = sinBeta*(Fl*sinPhi + Fr*cosPhi) + F(3) = (Fl*cosPhi - Fr*sinPhi) + F(4) = -sinBeta * M + F(5) = cosBeta * M + F(6) = 0.0 + + F1 = F*alpha + F2 = F*(1.0_ReKi-alpha) END SUBROUTINE DistributeElementLoads !---------------------------------------------------------------------------------------------------------------------------------- ! Takes loads on end node i and converts to 6DOF loads, adding to the nodes existing loads -SUBROUTINE AddEndLoad(Fl, M, sinPhi, cosPhi, SinBeta, cosBeta, Fi) +PURE SUBROUTINE AddEndLoad(Fl, M, sinPhi, cosPhi, SinBeta, cosBeta, Fi) REAL(ReKi), INTENT ( IN ) :: Fl ! (N) axial load about node i REAL(ReKi), INTENT ( IN ) :: M ! (N-m) radial moment about node i, positive in direction of tilt angle @@ -4294,7 +4292,7 @@ SUBROUTINE Morison_UpdateDiscState( Time, u, p, x, xd, z, OtherState, m, errStat END IF ! Get fluid velocity at the joint - CALL WaveField_GetNodeWaveVel( p%WaveField, m%WaveField_m, Time, pos, .FALSE., nodeInWater, FVTmp, ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveVel( p%WaveField, m%WaveField_m, Time, pos, .FALSE., .TRUE., nodeInWater, FVTmp, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FV = REAL(FVTmp, ReKi) vrel = ( FV - u%Mesh%TranslationVel(:,J) ) * nodeInWater diff --git a/modules/hydrodyn/src/Morison.txt b/modules/hydrodyn/src/Morison.txt index 5276e6dfa3..6ecbdbefd8 100644 --- a/modules/hydrodyn/src/Morison.txt +++ b/modules/hydrodyn/src/Morison.txt @@ -323,7 +323,7 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi V_rel_n {:} - - "Normal relative flow velocity at joints" m/s typedef ^ ^ ReKi V_rel_n_HiPass {:} - - "High-pass filtered normal relative flow velocity at joints" m/s typedef ^ ^ MeshMapType VisMeshMap - - - "Mesh mapping for visualization mesh" - -typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - +typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState WaveField module" - # ..... Parameters ................................................................................................................ # Define parameters here: diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index debd48162d..388afb1bdd 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -386,7 +386,7 @@ MODULE Morison_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: V_rel_n !< Normal relative flow velocity at joints [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: V_rel_n_HiPass !< High-pass filtered normal relative flow velocity at joints [m/s] TYPE(MeshMapType) :: VisMeshMap !< Mesh mapping for visualization mesh [-] - TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] + TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState WaveField module [-] END TYPE Morison_MiscVarType ! ======================= ! ========= Morison_ParameterType ======= @@ -433,7 +433,15 @@ MODULE Morison_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< [-] END TYPE Morison_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: Morison_x_DummyContState = 1 ! Morison%DummyContState + integer(IntKi), public, parameter :: Morison_z_DummyConstrState = 2 ! Morison%DummyConstrState + integer(IntKi), public, parameter :: Morison_u_Mesh = 3 ! Morison%Mesh + integer(IntKi), public, parameter :: Morison_u_PtfmRefY = 4 ! Morison%PtfmRefY + integer(IntKi), public, parameter :: Morison_y_Mesh = 5 ! Morison%Mesh + integer(IntKi), public, parameter :: Morison_y_VisMesh = 6 ! Morison%VisMesh + integer(IntKi), public, parameter :: Morison_y_WriteOutput = 7 ! Morison%WriteOutput + +contains subroutine Morison_CopyJointType(SrcJointTypeData, DstJointTypeData, CtrlCode, ErrStat, ErrMsg) type(Morison_JointType), intent(in) :: SrcJointTypeData @@ -4671,5 +4679,301 @@ SUBROUTINE Morison_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function Morison_InputMeshPointer(u, DL) result(Mesh) + type(Morison_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (Morison_u_Mesh) + Mesh => u%Mesh + end select +end function + +function Morison_OutputMeshPointer(y, DL) result(Mesh) + type(Morison_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (Morison_y_Mesh) + Mesh => y%Mesh + case (Morison_y_VisMesh) + Mesh => y%VisMesh + end select +end function + +subroutine Morison_VarsPackContState(Vars, x, ValAry) + type(Morison_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call Morison_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine Morison_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(Morison_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Morison_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Morison_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Morison_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call Morison_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine Morison_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Morison_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Morison_x_DummyContState) + x%DummyContState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function Morison_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Morison_x_DummyContState) + Name = "x%DummyContState" + case default + Name = "Unknown Field" + end select +end function + +subroutine Morison_VarsPackContStateDeriv(Vars, x, ValAry) + type(Morison_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call Morison_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine Morison_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(Morison_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Morison_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Morison_VarsPackConstrState(Vars, z, ValAry) + type(Morison_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call Morison_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine Morison_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(Morison_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Morison_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Morison_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Morison_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call Morison_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine Morison_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Morison_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Morison_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function Morison_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Morison_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine Morison_VarsPackInput(Vars, u, ValAry) + type(Morison_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call Morison_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine Morison_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(Morison_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Morison_u_Mesh) + call MV_PackMesh(V, u%Mesh, ValAry) ! Mesh + case (Morison_u_PtfmRefY) + VarVals(1) = u%PtfmRefY ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Morison_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Morison_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call Morison_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine Morison_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Morison_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Morison_u_Mesh) + call MV_UnpackMesh(V, ValAry, u%Mesh) ! Mesh + case (Morison_u_PtfmRefY) + u%PtfmRefY = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function Morison_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Morison_u_Mesh) + Name = "u%Mesh" + case (Morison_u_PtfmRefY) + Name = "u%PtfmRefY" + case default + Name = "Unknown Field" + end select +end function + +subroutine Morison_VarsPackOutput(Vars, y, ValAry) + type(Morison_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call Morison_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine Morison_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(Morison_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Morison_y_Mesh) + call MV_PackMesh(V, y%Mesh, ValAry) ! Mesh + case (Morison_y_VisMesh) + call MV_PackMesh(V, y%VisMesh, ValAry) ! Mesh + case (Morison_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Morison_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Morison_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call Morison_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine Morison_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Morison_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Morison_y_Mesh) + call MV_UnpackMesh(V, ValAry, y%Mesh) ! Mesh + case (Morison_y_VisMesh) + call MV_UnpackMesh(V, ValAry, y%VisMesh) ! Mesh + case (Morison_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function Morison_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Morison_y_Mesh) + Name = "y%Mesh" + case (Morison_y_VisMesh) + Name = "y%VisMesh" + case (Morison_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE Morison_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 22ba2cac7b..7b4ddf2602 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -101,7 +101,13 @@ MODULE SS_Excitation_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< output Data [kN] END TYPE SS_Exc_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: SS_Exc_x_x = 1 ! SS_Exc%x + integer(IntKi), public, parameter :: SS_Exc_z_DummyConstrState = 2 ! SS_Exc%DummyConstrState + integer(IntKi), public, parameter :: SS_Exc_u_PtfmPos = 3 ! SS_Exc%PtfmPos + integer(IntKi), public, parameter :: SS_Exc_y_y = 4 ! SS_Exc%y + integer(IntKi), public, parameter :: SS_Exc_y_WriteOutput = 5 ! SS_Exc%WriteOutput + +contains subroutine SS_Exc_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(SS_Exc_InitInputType), intent(in) :: SrcInitInputData @@ -1151,5 +1157,283 @@ SUBROUTINE SS_Exc_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function SS_Exc_InputMeshPointer(u, DL) result(Mesh) + type(SS_Exc_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +function SS_Exc_OutputMeshPointer(y, DL) result(Mesh) + type(SS_Exc_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +subroutine SS_Exc_VarsPackContState(Vars, x, ValAry) + type(SS_Exc_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SS_Exc_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine SS_Exc_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SS_Exc_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Exc_x_x) + VarVals = x%x(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SS_Exc_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Exc_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SS_Exc_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine SS_Exc_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Exc_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Exc_x_x) + x%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function SS_Exc_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SS_Exc_x_x) + Name = "x%x" + case default + Name = "Unknown Field" + end select +end function + +subroutine SS_Exc_VarsPackContStateDeriv(Vars, x, ValAry) + type(SS_Exc_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SS_Exc_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine SS_Exc_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SS_Exc_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Exc_x_x) + VarVals = x%x(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SS_Exc_VarsPackConstrState(Vars, z, ValAry) + type(SS_Exc_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call SS_Exc_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine SS_Exc_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(SS_Exc_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Exc_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SS_Exc_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Exc_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call SS_Exc_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine SS_Exc_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Exc_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Exc_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function SS_Exc_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SS_Exc_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine SS_Exc_VarsPackInput(Vars, u, ValAry) + type(SS_Exc_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call SS_Exc_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine SS_Exc_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(SS_Exc_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Exc_u_PtfmPos) + VarVals = u%PtfmPos(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SS_Exc_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Exc_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call SS_Exc_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine SS_Exc_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Exc_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Exc_u_PtfmPos) + u%PtfmPos(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + +function SS_Exc_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SS_Exc_u_PtfmPos) + Name = "u%PtfmPos" + case default + Name = "Unknown Field" + end select +end function + +subroutine SS_Exc_VarsPackOutput(Vars, y, ValAry) + type(SS_Exc_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call SS_Exc_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine SS_Exc_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(SS_Exc_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Exc_y_y) + VarVals = y%y(V%iLB:V%iUB) ! Rank 1 Array + case (SS_Exc_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SS_Exc_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Exc_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call SS_Exc_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine SS_Exc_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Exc_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Exc_y_y) + y%y(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SS_Exc_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function SS_Exc_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SS_Exc_y_y) + Name = "y%y" + case (SS_Exc_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE SS_Excitation_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index 59b45510aa..aa51b5f25c 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -95,7 +95,13 @@ MODULE SS_Radiation_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< output Data [(kN)] END TYPE SS_Rad_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: SS_Rad_x_x = 1 ! SS_Rad%x + integer(IntKi), public, parameter :: SS_Rad_z_DummyConstrState = 2 ! SS_Rad%DummyConstrState + integer(IntKi), public, parameter :: SS_Rad_u_dq = 3 ! SS_Rad%dq + integer(IntKi), public, parameter :: SS_Rad_y_y = 4 ! SS_Rad%y + integer(IntKi), public, parameter :: SS_Rad_y_WriteOutput = 5 ! SS_Rad%WriteOutput + +contains subroutine SS_Rad_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(SS_Rad_InitInputType), intent(in) :: SrcInitInputData @@ -1072,5 +1078,283 @@ SUBROUTINE SS_Rad_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function SS_Rad_InputMeshPointer(u, DL) result(Mesh) + type(SS_Rad_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +function SS_Rad_OutputMeshPointer(y, DL) result(Mesh) + type(SS_Rad_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +subroutine SS_Rad_VarsPackContState(Vars, x, ValAry) + type(SS_Rad_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SS_Rad_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine SS_Rad_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SS_Rad_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Rad_x_x) + VarVals = x%x(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SS_Rad_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Rad_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SS_Rad_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine SS_Rad_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Rad_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Rad_x_x) + x%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function SS_Rad_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SS_Rad_x_x) + Name = "x%x" + case default + Name = "Unknown Field" + end select +end function + +subroutine SS_Rad_VarsPackContStateDeriv(Vars, x, ValAry) + type(SS_Rad_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SS_Rad_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine SS_Rad_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SS_Rad_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Rad_x_x) + VarVals = x%x(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SS_Rad_VarsPackConstrState(Vars, z, ValAry) + type(SS_Rad_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call SS_Rad_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine SS_Rad_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(SS_Rad_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Rad_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SS_Rad_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Rad_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call SS_Rad_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine SS_Rad_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Rad_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Rad_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function SS_Rad_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SS_Rad_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine SS_Rad_VarsPackInput(Vars, u, ValAry) + type(SS_Rad_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call SS_Rad_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine SS_Rad_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(SS_Rad_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Rad_u_dq) + VarVals = u%dq(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SS_Rad_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Rad_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call SS_Rad_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine SS_Rad_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Rad_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Rad_u_dq) + u%dq(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function SS_Rad_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SS_Rad_u_dq) + Name = "u%dq" + case default + Name = "Unknown Field" + end select +end function + +subroutine SS_Rad_VarsPackOutput(Vars, y, ValAry) + type(SS_Rad_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call SS_Rad_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine SS_Rad_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(SS_Rad_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Rad_y_y) + VarVals = y%y(V%iLB:V%iUB) ! Rank 1 Array + case (SS_Rad_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SS_Rad_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Rad_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call SS_Rad_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine SS_Rad_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SS_Rad_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SS_Rad_y_y) + y%y(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SS_Rad_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function SS_Rad_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SS_Rad_y_y) + Name = "y%y" + case (SS_Rad_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE SS_Radiation_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index 5f928caa56..e4b8800d70 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -34,7 +34,7 @@ MODULE WAMIT2_Types USE SeaSt_WaveField_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: MaxWAMIT2Outputs = 6 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MaxWAMIT2Outputs = 6 ! [-] ! ========= WAMIT2_InitInputType ======= TYPE, PUBLIC :: WAMIT2_InitInputType LOGICAL :: HasWAMIT = .false. !< .TRUE. if using WAMIT model, .FALSE. otherwise [-] @@ -91,7 +91,9 @@ MODULE WAMIT2_Types TYPE(MeshType) :: Mesh !< Loads at the platform reference point in the inertial frame [-] END TYPE WAMIT2_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: WAMIT2_y_Mesh = 1 ! WAMIT2%Mesh + +contains subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(WAMIT2_InitInputType), intent(in) :: SrcInitInputData @@ -673,5 +675,75 @@ SUBROUTINE WAMIT2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, 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 + +function WAMIT2_OutputMeshPointer(y, DL) result(Mesh) + type(WAMIT2_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (WAMIT2_y_Mesh) + Mesh => y%Mesh + end select +end function + +subroutine WAMIT2_VarsPackOutput(Vars, y, ValAry) + type(WAMIT2_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call WAMIT2_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine WAMIT2_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(WAMIT2_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WAMIT2_y_Mesh) + call MV_PackMesh(V, y%Mesh, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WAMIT2_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT2_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call WAMIT2_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine WAMIT2_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT2_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WAMIT2_y_Mesh) + call MV_UnpackMesh(V, ValAry, y%Mesh) ! Mesh + end select + end associate +end subroutine + +function WAMIT2_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (WAMIT2_y_Mesh) + Name = "y%Mesh" + case default + Name = "Unknown Field" + end select +end function + END MODULE WAMIT2_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/WAMIT_Interp.f90 b/modules/hydrodyn/src/WAMIT_Interp.f90 index 90a95e3432..0777c2fe1c 100644 --- a/modules/hydrodyn/src/WAMIT_Interp.f90 +++ b/modules/hydrodyn/src/WAMIT_Interp.f90 @@ -668,15 +668,15 @@ function WAMIT_ForceWaves_Interp_3D_vec6(Time, pos, pKinXX, WF_p, WF_m, ErrStat3 ! interpolate do i = 1,6 - u(1) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), i ) - u(2) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), i ) + u(1) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), i ) + u(2) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), i ) u(3) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), i ) - u(4) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), i ) - u(5) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), i ) - u(6) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), i ) + u(4) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), i ) + u(5) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), i ) + u(6) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), i ) u(7) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), i ) - u(8) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), i ) - WAMIT_ForceWaves_Interp_3D_vec6(i) = SUM ( WF_m%N3D * u ) + u(8) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), i ) + WAMIT_ForceWaves_Interp_3D_vec6(i) = dot_product(WF_m%N3D, u) end do end function @@ -702,22 +702,22 @@ function WAMIT_ForceWaves_Interp_4D_vec6(Time, pos, pKinXX, WF_p, WF_m, ErrStat3 ! interpolate do i = 1,6 u( 1) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) - u( 2) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) - u( 3) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) - u( 4) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) - u( 5) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) - u( 6) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) + u( 2) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) + u( 3) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) + u( 4) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) + u( 5) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) + u( 6) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) u( 7) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) - u( 8) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) - u( 9) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) + u( 8) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) + u( 9) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) u(10) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) - u(11) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) - u(12) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) - u(13) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) - u(14) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) - u(15) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) + u(11) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) + u(12) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) + u(13) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) + u(14) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) + u(15) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) u(16) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) - WAMIT_ForceWaves_Interp_4D_vec6(i) = SUM ( WF_m%N4D * u ) + WAMIT_ForceWaves_Interp_4D_vec6(i) = dot_product(WF_m%N4D, u) end do end function diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index cfa511e855..761b3130e2 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -147,7 +147,17 @@ MODULE WAMIT_Types TYPE(MeshType) :: Mesh !< Loads at the WAMIT reference point in the inertial frame [-] END TYPE WAMIT_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: WAMIT_x_SS_Rdtn_x = 1 ! WAMIT%SS_Rdtn%x + integer(IntKi), public, parameter :: WAMIT_x_SS_Exctn_x = 2 ! WAMIT%SS_Exctn%x + integer(IntKi), public, parameter :: WAMIT_x_Conv_Rdtn_DummyContState = 3 ! WAMIT%Conv_Rdtn%DummyContState + integer(IntKi), public, parameter :: WAMIT_z_Conv_Rdtn_DummyConstrState = 4 ! WAMIT%Conv_Rdtn%DummyConstrState + integer(IntKi), public, parameter :: WAMIT_z_SS_Rdtn_DummyConstrState = 5 ! WAMIT%SS_Rdtn%DummyConstrState + integer(IntKi), public, parameter :: WAMIT_z_SS_Exctn_DummyConstrState = 6 ! WAMIT%SS_Exctn%DummyConstrState + integer(IntKi), public, parameter :: WAMIT_u_Mesh = 7 ! WAMIT%Mesh + integer(IntKi), public, parameter :: WAMIT_u_PtfmRefY = 8 ! WAMIT%PtfmRefY + integer(IntKi), public, parameter :: WAMIT_y_Mesh = 9 ! WAMIT%Mesh + +contains subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(WAMIT_InitInputType), intent(in) :: SrcInitInputData @@ -1462,5 +1472,315 @@ SUBROUTINE WAMIT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, 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 + +function WAMIT_InputMeshPointer(u, DL) result(Mesh) + type(WAMIT_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (WAMIT_u_Mesh) + Mesh => u%Mesh + end select +end function + +function WAMIT_OutputMeshPointer(y, DL) result(Mesh) + type(WAMIT_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (WAMIT_y_Mesh) + Mesh => y%Mesh + end select +end function + +subroutine WAMIT_VarsPackContState(Vars, x, ValAry) + type(WAMIT_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call WAMIT_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine WAMIT_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(WAMIT_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WAMIT_x_SS_Rdtn_x) + VarVals = x%SS_Rdtn%x(V%iLB:V%iUB) ! Rank 1 Array + case (WAMIT_x_SS_Exctn_x) + VarVals = x%SS_Exctn%x(V%iLB:V%iUB) ! Rank 1 Array + case (WAMIT_x_Conv_Rdtn_DummyContState) + VarVals(1) = x%Conv_Rdtn%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WAMIT_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call WAMIT_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine WAMIT_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WAMIT_x_SS_Rdtn_x) + x%SS_Rdtn%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (WAMIT_x_SS_Exctn_x) + x%SS_Exctn%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (WAMIT_x_Conv_Rdtn_DummyContState) + x%Conv_Rdtn%DummyContState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function WAMIT_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (WAMIT_x_SS_Rdtn_x) + Name = "x%SS_Rdtn%x" + case (WAMIT_x_SS_Exctn_x) + Name = "x%SS_Exctn%x" + case (WAMIT_x_Conv_Rdtn_DummyContState) + Name = "x%Conv_Rdtn%DummyContState" + case default + Name = "Unknown Field" + end select +end function + +subroutine WAMIT_VarsPackContStateDeriv(Vars, x, ValAry) + type(WAMIT_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call WAMIT_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine WAMIT_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(WAMIT_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WAMIT_x_SS_Rdtn_x) + VarVals = x%SS_Rdtn%x(V%iLB:V%iUB) ! Rank 1 Array + case (WAMIT_x_SS_Exctn_x) + VarVals = x%SS_Exctn%x(V%iLB:V%iUB) ! Rank 1 Array + case (WAMIT_x_Conv_Rdtn_DummyContState) + VarVals(1) = x%Conv_Rdtn%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WAMIT_VarsPackConstrState(Vars, z, ValAry) + type(WAMIT_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call WAMIT_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine WAMIT_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(WAMIT_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WAMIT_z_Conv_Rdtn_DummyConstrState) + VarVals(1) = z%Conv_Rdtn%DummyConstrState ! Scalar + case (WAMIT_z_SS_Rdtn_DummyConstrState) + VarVals(1) = z%SS_Rdtn%DummyConstrState ! Scalar + case (WAMIT_z_SS_Exctn_DummyConstrState) + VarVals(1) = z%SS_Exctn%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WAMIT_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call WAMIT_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine WAMIT_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WAMIT_z_Conv_Rdtn_DummyConstrState) + z%Conv_Rdtn%DummyConstrState = VarVals(1) ! Scalar + case (WAMIT_z_SS_Rdtn_DummyConstrState) + z%SS_Rdtn%DummyConstrState = VarVals(1) ! Scalar + case (WAMIT_z_SS_Exctn_DummyConstrState) + z%SS_Exctn%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function WAMIT_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (WAMIT_z_Conv_Rdtn_DummyConstrState) + Name = "z%Conv_Rdtn%DummyConstrState" + case (WAMIT_z_SS_Rdtn_DummyConstrState) + Name = "z%SS_Rdtn%DummyConstrState" + case (WAMIT_z_SS_Exctn_DummyConstrState) + Name = "z%SS_Exctn%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine WAMIT_VarsPackInput(Vars, u, ValAry) + type(WAMIT_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call WAMIT_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine WAMIT_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(WAMIT_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WAMIT_u_Mesh) + call MV_PackMesh(V, u%Mesh, ValAry) ! Mesh + case (WAMIT_u_PtfmRefY) + VarVals(1) = u%PtfmRefY ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WAMIT_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call WAMIT_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine WAMIT_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WAMIT_u_Mesh) + call MV_UnpackMesh(V, ValAry, u%Mesh) ! Mesh + case (WAMIT_u_PtfmRefY) + u%PtfmRefY = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function WAMIT_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (WAMIT_u_Mesh) + Name = "u%Mesh" + case (WAMIT_u_PtfmRefY) + Name = "u%PtfmRefY" + case default + Name = "Unknown Field" + end select +end function + +subroutine WAMIT_VarsPackOutput(Vars, y, ValAry) + type(WAMIT_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call WAMIT_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine WAMIT_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(WAMIT_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WAMIT_y_Mesh) + call MV_PackMesh(V, y%Mesh, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WAMIT_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call WAMIT_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine WAMIT_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(WAMIT_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WAMIT_y_Mesh) + call MV_UnpackMesh(V, ValAry, y%Mesh) ! Mesh + end select + end associate +end subroutine + +function WAMIT_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (WAMIT_y_Mesh) + Name = "y%Mesh" + case default + Name = "Unknown Field" + end select +end function + END MODULE WAMIT_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/icedyn/src/IceDyn.f90 b/modules/icedyn/src/IceDyn.f90 index 9abd548d9f..e8ab5ed01e 100644 --- a/modules/icedyn/src/IceDyn.f90 +++ b/modules/icedyn/src/IceDyn.f90 @@ -263,17 +263,18 @@ SUBROUTINE IceD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO ' m/s^2) differs from gravity in glue code ('//trim(num2Lstr(InitInp%gravity))//' m/s^2).') END IF - - - ! ! Print the summary file if requested: - ! IF (InputFileData%SumPrint) THEN - ! CALL IceD_PrintSum( p, OtherState, ErrStat2, ErrMsg2 ) - ! CALL CheckError( ErrStat2, ErrMsg2 ) - ! IF (ErrStat >= AbortErrLev) RETURN - ! END IF - - ! Destroy the InputFileData structure (deallocate arrays) - + ! Print the summary file if requested: + ! IF (InputFileData%SumPrint) THEN + ! CALL IceD_PrintSum( p, OtherState, ErrStat2, ErrMsg2 ) + ! CALL CheckError( ErrStat2, ErrMsg2 ) + ! IF (ErrStat >= AbortErrLev) RETURN + ! END IF + + ! Initialize module variables + CALL IceD_InitVars(u, p, x, y, m, InitOut%Vars, InputFileData, .false., ErrStat2, ErrMsg2) + CALL CheckError(ErrStat2, ErrMsg2) + + ! Destroy the InputFileData structure (deallocate arrays) CALL IceD_DestroyInputFile(InputFileData, ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN @@ -314,6 +315,56 @@ SUBROUTINE CheckError(ErrID,Msg) END SUBROUTINE CheckError END SUBROUTINE IceD_Init + +subroutine IceD_InitVars(u, p, x, y, m, Vars, InputFileData, Linearize, ErrStat, ErrMsg) + type(IceD_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(IceD_ParameterType), intent(inout) :: p !< Parameters + type(IceD_ContinuousStateType), intent(inout) :: x !< Continuous state + type(IceD_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(IceD_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(ModVarsType), intent(inout) :: Vars !< Module variables + type(IceD_InputFile), intent(in) :: InputFileData !< Input file data + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_No ne + + character(*), parameter :: RoutineName = 'IceD_InitVars' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Initialization dependent on linearization + !---------------------------------------------------------------------------- + + call MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + call IceD_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call IceD_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call IceD_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call IceD_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the end of the simulation. SUBROUTINE IceD_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index 30d8c26097..e8cbce9737 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -114,6 +114,7 @@ MODULE IceDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] INTEGER(IntKi) :: numLegs = 0_IntKi !< Number of legs on the structure [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + TYPE(ModVarsType) :: Vars !< Module Variables [-] END TYPE IceD_InitOutputType ! ======================= ! ========= IceD_ContinuousStateType ======= @@ -146,11 +147,6 @@ MODULE IceDyn_Types INTEGER(IntKi) :: n = 0_IntKi !< tracks time step for which OtherState was updated [-] END TYPE IceD_OtherStateType ! ======================= -! ========= IceD_MiscVarType ======= - TYPE, PUBLIC :: IceD_MiscVarType - INTEGER(IntKi) :: DummyMiscVar = 0_IntKi !< Remove this variable if you have misc/optimization variables [-] - END TYPE IceD_MiscVarType -! ======================= ! ========= IceD_ParameterType ======= TYPE, PUBLIC :: IceD_ParameterType REAL(ReKi) :: h = 0.0_ReKi !< Ice thickness [m] @@ -224,7 +220,24 @@ MODULE IceDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] END TYPE IceD_OutputType ! ======================= -CONTAINS +! ========= IceD_MiscVarType ======= + TYPE, PUBLIC :: IceD_MiscVarType + INTEGER(IntKi) :: DummyMiscVar = 0_IntKi !< Remove this variable if you have misc/optimization variables [-] + TYPE(ModJacType) :: Jac !< Values [corresponding] + TYPE(IceD_ContinuousStateType) :: x_perturb !< [-] + TYPE(IceD_ContinuousStateType) :: dxdt_lin !< [-] + TYPE(IceD_InputType) :: u_perturb !< [-] + TYPE(IceD_OutputType) :: y_lin !< [-] + END TYPE IceD_MiscVarType +! ======================= + integer(IntKi), public, parameter :: IceD_x_q = 1 ! IceD%q + integer(IntKi), public, parameter :: IceD_x_dqdt = 2 ! IceD%dqdt + integer(IntKi), public, parameter :: IceD_z_DummyConstrState = 3 ! IceD%DummyConstrState + integer(IntKi), public, parameter :: IceD_u_PointMesh = 4 ! IceD%PointMesh + integer(IntKi), public, parameter :: IceD_y_PointMesh = 5 ! IceD%PointMesh + integer(IntKi), public, parameter :: IceD_y_WriteOutput = 6 ! IceD%WriteOutput + +contains subroutine IceD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) type(IceD_InputFile), intent(in) :: SrcInputFileData @@ -584,6 +597,9 @@ subroutine IceD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine IceD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -603,6 +619,8 @@ subroutine IceD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine IceD_PackInitOutput(RF, Indata) @@ -614,6 +632,7 @@ subroutine IceD_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%WriteOutputUnt) call RegPack(RF, InData%numLegs) call NWTC_Library_PackProgDesc(RF, InData%Ver) + call NWTC_Library_PackModVarsType(RF, InData%Vars) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -629,6 +648,7 @@ subroutine IceD_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%numLegs); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end subroutine subroutine IceD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -913,44 +933,6 @@ subroutine IceD_UnPackOtherState(RF, OutData) call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(IceD_MiscVarType), intent(in) :: SrcMiscData - type(IceD_MiscVarType), intent(inout) :: DstMiscData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'IceD_CopyMisc' - ErrStat = ErrID_None - ErrMsg = '' - DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar -end subroutine - -subroutine IceD_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(IceD_MiscVarType), intent(inout) :: MiscData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'IceD_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine IceD_PackMisc(RF, Indata) - type(RegFile), intent(inout) :: RF - type(IceD_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'IceD_PackMisc' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%DummyMiscVar) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine IceD_UnPackMisc(RF, OutData) - type(RegFile), intent(inout) :: RF - type(IceD_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'IceD_UnPackMisc' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%DummyMiscVar); if (RegCheckErr(RF, RoutineName)) return -end subroutine - subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) type(IceD_ParameterType), intent(in) :: SrcParamData type(IceD_ParameterType), intent(inout) :: DstParamData @@ -1418,6 +1400,83 @@ subroutine IceD_UnPackOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine +subroutine IceD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(IceD_MiscVarType), intent(inout) :: SrcMiscData + type(IceD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceD_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceD_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceD_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceD_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine IceD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(IceD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceD_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceD_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceD_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceD_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine IceD_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyMiscVar) + call NWTC_Library_PackModJacType(RF, InData%Jac) + call IceD_PackContState(RF, InData%x_perturb) + call IceD_PackContState(RF, InData%dxdt_lin) + call IceD_PackInput(RF, InData%u_perturb) + call IceD_PackOutput(RF, InData%y_lin) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceD_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackMisc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyMiscVar); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call IceD_UnpackContState(RF, OutData%x_perturb) ! x_perturb + call IceD_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin + call IceD_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call IceD_UnpackOutput(RF, OutData%y_lin) ! y_lin +end subroutine + subroutine IceD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time @@ -1739,5 +1798,295 @@ SUBROUTINE IceD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function IceD_InputMeshPointer(u, DL) result(Mesh) + type(IceD_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (IceD_u_PointMesh) + Mesh => u%PointMesh + end select +end function + +function IceD_OutputMeshPointer(y, DL) result(Mesh) + type(IceD_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (IceD_y_PointMesh) + Mesh => y%PointMesh + end select +end function + +subroutine IceD_VarsPackContState(Vars, x, ValAry) + type(IceD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call IceD_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine IceD_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(IceD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceD_x_q) + VarVals(1) = x%q ! Scalar + case (IceD_x_dqdt) + VarVals(1) = x%dqdt ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine IceD_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(IceD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call IceD_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine IceD_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(IceD_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceD_x_q) + x%q = VarVals(1) ! Scalar + case (IceD_x_dqdt) + x%dqdt = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function IceD_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (IceD_x_q) + Name = "x%q" + case (IceD_x_dqdt) + Name = "x%dqdt" + case default + Name = "Unknown Field" + end select +end function + +subroutine IceD_VarsPackContStateDeriv(Vars, x, ValAry) + type(IceD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call IceD_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine IceD_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(IceD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceD_x_q) + VarVals(1) = x%q ! Scalar + case (IceD_x_dqdt) + VarVals(1) = x%dqdt ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine IceD_VarsPackConstrState(Vars, z, ValAry) + type(IceD_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call IceD_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine IceD_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(IceD_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceD_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine IceD_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(IceD_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call IceD_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine IceD_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(IceD_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceD_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function IceD_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (IceD_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine IceD_VarsPackInput(Vars, u, ValAry) + type(IceD_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call IceD_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine IceD_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(IceD_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceD_u_PointMesh) + call MV_PackMesh(V, u%PointMesh, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine IceD_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(IceD_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call IceD_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine IceD_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(IceD_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceD_u_PointMesh) + call MV_UnpackMesh(V, ValAry, u%PointMesh) ! Mesh + end select + end associate +end subroutine + +function IceD_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (IceD_u_PointMesh) + Name = "u%PointMesh" + case default + Name = "Unknown Field" + end select +end function + +subroutine IceD_VarsPackOutput(Vars, y, ValAry) + type(IceD_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call IceD_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine IceD_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(IceD_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceD_y_PointMesh) + call MV_PackMesh(V, y%PointMesh, ValAry) ! Mesh + case (IceD_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine IceD_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(IceD_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call IceD_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine IceD_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(IceD_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceD_y_PointMesh) + call MV_UnpackMesh(V, ValAry, y%PointMesh) ! Mesh + case (IceD_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function IceD_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (IceD_y_PointMesh) + Name = "y%PointMesh" + case (IceD_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE IceDyn_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/icedyn/src/Registry_IceDyn.txt b/modules/icedyn/src/Registry_IceDyn.txt index b230ebf9d9..d0643fcb0c 100644 --- a/modules/icedyn/src/Registry_IceDyn.txt +++ b/modules/icedyn/src/Registry_IceDyn.txt @@ -111,7 +111,7 @@ typedef IceDyn/IceD InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} typedef ^ ^ ^ WriteOutputUnt {:} - - "Units of the output-to-file channels" - typedef ^ ^ IntKi numLegs - - - "Number of legs on the structure" - typedef ^ ^ ProgDesc Ver - - - "This module's name, version, and date" - - +typedef ^ ^ ModVarsType Vars - - - "Module Variables" # ..... States .................................................................................................................... # Define continuous (differentiable) states here: @@ -142,13 +142,6 @@ typedef ^ ^ ReKi dxc typedef ^ ^ IceD_ContinuousStateType xdot {:} - - "previous state deriv for multi-step" m typedef ^ ^ IntKi n - - - "tracks time step for which OtherState was updated" - - -# ..... Misc/Optimization variables................................................................................................. -# Define any data that are used only for efficiency purposes (these variables are not associated with time): -# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. -typedef ^ MiscVarType IntKi DummyMiscVar - - - "Remove this variable if you have misc/optimization variables" - - - # ..... Parameters ................................................................................................................ # Define parameters here: # ..... General parameters ........................................................................................................ @@ -232,3 +225,12 @@ typedef IceDyn/IceD InputType MeshType PointMesh typedef IceDyn/IceD OutputType MeshType PointMesh - - - "contains Ice force" N typedef ^ ^ ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" +# ..... Misc/Optimization variables................................................................................................. +# Define any data that are used only for efficiency purposes (these variables are not associated with time): +# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. +typedef ^ MiscVarType IntKi DummyMiscVar - - - "Remove this variable if you have misc/optimization variables" - +typedef ^ MiscVarType ModJacType Jac - - - Values corresponding to module variables" +typedef ^ MiscVarType IceD_ContinuousStateType x_perturb - - - "" - +typedef ^ MiscVarType IceD_ContinuousStateType dxdt_lin - - - "" - +typedef ^ MiscVarType IceD_InputType u_perturb - - - "" - +typedef ^ MiscVarType IceD_OutputType y_lin - - - "" - diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index 28befef3c4..8abe5a27dc 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -47,6 +47,7 @@ MODULE IceFloe_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + TYPE(ModVarsType) :: Vars !< Module Variables [-] END TYPE IceFloe_InitOutputType ! ======================= ! ========= IceFloe_ContinuousStateType ======= @@ -69,11 +70,6 @@ MODULE IceFloe_Types INTEGER(IntKi) :: DummyOtherState = 0_IntKi !< Remove this variable if you have other states [-] END TYPE IceFloe_OtherStateType ! ======================= -! ========= IceFloe_MiscVarType ======= - TYPE, PUBLIC :: IceFloe_MiscVarType - INTEGER(IntKi) :: DummyMiscVar = 0_IntKi !< Remove this variable if you have misc/optimization variables [-] - END TYPE IceFloe_MiscVarType -! ======================= ! ========= IceFloe_ParameterType ======= TYPE, PUBLIC :: IceFloe_ParameterType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: loadSeries !< - [precalculated time series of ice loads for each leg] @@ -108,7 +104,23 @@ MODULE IceFloe_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] END TYPE IceFloe_OutputType ! ======================= -CONTAINS +! ========= IceFloe_MiscVarType ======= + TYPE, PUBLIC :: IceFloe_MiscVarType + INTEGER(IntKi) :: DummyMiscVar = 0_IntKi !< Remove this variable if you have misc/optimization variables [-] + TYPE(ModJacType) :: Jac !< Values [corresponding] + TYPE(IceFloe_ContinuousStateType) :: x_perturb !< [-] + TYPE(IceFloe_ContinuousStateType) :: dxdt_lin !< [-] + TYPE(IceFloe_InputType) :: u_perturb !< [-] + TYPE(IceFloe_OutputType) :: y_lin !< [-] + END TYPE IceFloe_MiscVarType +! ======================= + integer(IntKi), public, parameter :: IceFloe_x_DummyContStateVar = 1 ! IceFloe%DummyContStateVar + integer(IntKi), public, parameter :: IceFloe_z_DummyConstrStateVar = 2 ! IceFloe%DummyConstrStateVar + integer(IntKi), public, parameter :: IceFloe_u_iceMesh = 3 ! IceFloe%iceMesh + integer(IntKi), public, parameter :: IceFloe_y_iceMesh = 4 ! IceFloe%iceMesh + integer(IntKi), public, parameter :: IceFloe_y_WriteOutput = 5 ! IceFloe%WriteOutput + +contains subroutine IceFloe_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(IceFloe_InitInputType), intent(in) :: SrcInitInputData @@ -199,6 +211,9 @@ subroutine IceFloe_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine IceFloe_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -218,6 +233,8 @@ subroutine IceFloe_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine IceFloe_PackInitOutput(RF, Indata) @@ -228,6 +245,7 @@ subroutine IceFloe_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) call NWTC_Library_PackProgDesc(RF, InData%Ver) + call NWTC_Library_PackModVarsType(RF, InData%Vars) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -242,6 +260,7 @@ subroutine IceFloe_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end subroutine subroutine IceFloe_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -396,44 +415,6 @@ subroutine IceFloe_UnPackOtherState(RF, OutData) call RegUnpack(RF, OutData%DummyOtherState); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceFloe_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(IceFloe_MiscVarType), intent(in) :: SrcMiscData - type(IceFloe_MiscVarType), intent(inout) :: DstMiscData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'IceFloe_CopyMisc' - ErrStat = ErrID_None - ErrMsg = '' - DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar -end subroutine - -subroutine IceFloe_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(IceFloe_MiscVarType), intent(inout) :: MiscData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'IceFloe_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine IceFloe_PackMisc(RF, Indata) - type(RegFile), intent(inout) :: RF - type(IceFloe_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'IceFloe_PackMisc' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%DummyMiscVar) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine IceFloe_UnPackMisc(RF, OutData) - type(RegFile), intent(inout) :: RF - type(IceFloe_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'IceFloe_UnPackMisc' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%DummyMiscVar); if (RegCheckErr(RF, RoutineName)) return -end subroutine - subroutine IceFloe_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) type(IceFloe_ParameterType), intent(in) :: SrcParamData type(IceFloe_ParameterType), intent(inout) :: DstParamData @@ -700,6 +681,83 @@ subroutine IceFloe_UnPackOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine +subroutine IceFloe_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_MiscVarType), intent(inout) :: SrcMiscData + type(IceFloe_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceFloe_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceFloe_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceFloe_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceFloe_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceFloe_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine IceFloe_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(IceFloe_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceFloe_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceFloe_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceFloe_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceFloe_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceFloe_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine IceFloe_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceFloe_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyMiscVar) + call NWTC_Library_PackModJacType(RF, InData%Jac) + call IceFloe_PackContState(RF, InData%x_perturb) + call IceFloe_PackContState(RF, InData%dxdt_lin) + call IceFloe_PackInput(RF, InData%u_perturb) + call IceFloe_PackOutput(RF, InData%y_lin) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceFloe_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackMisc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyMiscVar); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call IceFloe_UnpackContState(RF, OutData%x_perturb) ! x_perturb + call IceFloe_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin + call IceFloe_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call IceFloe_UnpackOutput(RF, OutData%y_lin) ! y_lin +end subroutine + subroutine IceFloe_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time @@ -1021,5 +1079,287 @@ SUBROUTINE IceFloe_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function IceFloe_InputMeshPointer(u, DL) result(Mesh) + type(IceFloe_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (IceFloe_u_iceMesh) + Mesh => u%iceMesh + end select +end function + +function IceFloe_OutputMeshPointer(y, DL) result(Mesh) + type(IceFloe_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (IceFloe_y_iceMesh) + Mesh => y%iceMesh + end select +end function + +subroutine IceFloe_VarsPackContState(Vars, x, ValAry) + type(IceFloe_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call IceFloe_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine IceFloe_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(IceFloe_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceFloe_x_DummyContStateVar) + VarVals(1) = x%DummyContStateVar ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine IceFloe_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(IceFloe_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call IceFloe_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine IceFloe_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(IceFloe_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceFloe_x_DummyContStateVar) + x%DummyContStateVar = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function IceFloe_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (IceFloe_x_DummyContStateVar) + Name = "x%DummyContStateVar" + case default + Name = "Unknown Field" + end select +end function + +subroutine IceFloe_VarsPackContStateDeriv(Vars, x, ValAry) + type(IceFloe_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call IceFloe_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine IceFloe_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(IceFloe_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceFloe_x_DummyContStateVar) + VarVals(1) = x%DummyContStateVar ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine IceFloe_VarsPackConstrState(Vars, z, ValAry) + type(IceFloe_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call IceFloe_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine IceFloe_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(IceFloe_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceFloe_z_DummyConstrStateVar) + VarVals(1) = z%DummyConstrStateVar ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine IceFloe_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(IceFloe_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call IceFloe_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine IceFloe_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(IceFloe_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceFloe_z_DummyConstrStateVar) + z%DummyConstrStateVar = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function IceFloe_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (IceFloe_z_DummyConstrStateVar) + Name = "z%DummyConstrStateVar" + case default + Name = "Unknown Field" + end select +end function + +subroutine IceFloe_VarsPackInput(Vars, u, ValAry) + type(IceFloe_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call IceFloe_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine IceFloe_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(IceFloe_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceFloe_u_iceMesh) + call MV_PackMesh(V, u%iceMesh, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine IceFloe_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(IceFloe_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call IceFloe_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine IceFloe_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(IceFloe_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceFloe_u_iceMesh) + call MV_UnpackMesh(V, ValAry, u%iceMesh) ! Mesh + end select + end associate +end subroutine + +function IceFloe_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (IceFloe_u_iceMesh) + Name = "u%iceMesh" + case default + Name = "Unknown Field" + end select +end function + +subroutine IceFloe_VarsPackOutput(Vars, y, ValAry) + type(IceFloe_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call IceFloe_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine IceFloe_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(IceFloe_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceFloe_y_iceMesh) + call MV_PackMesh(V, y%iceMesh, ValAry) ! Mesh + case (IceFloe_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine IceFloe_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(IceFloe_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call IceFloe_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine IceFloe_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(IceFloe_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (IceFloe_y_iceMesh) + call MV_UnpackMesh(V, ValAry, y%iceMesh) ! Mesh + case (IceFloe_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function IceFloe_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (IceFloe_y_iceMesh) + Name = "y%iceMesh" + case (IceFloe_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE IceFloe_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/icefloe/src/interfaces/FAST/IceFloe.f90 b/modules/icefloe/src/interfaces/FAST/IceFloe.f90 index f257ddeb6e..652512882f 100644 --- a/modules/icefloe/src/interfaces/FAST/IceFloe.f90 +++ b/modules/icefloe/src/interfaces/FAST/IceFloe.f90 @@ -49,6 +49,7 @@ MODULE IceFloe use randomCrushing use IceCpldCrushing use NWTC_IO, only : DispNVD + use ModVar IMPLICIT NONE @@ -347,6 +348,11 @@ SUBROUTINE IceFloe_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In InitOut%WriteOutputUnt(4*n-3:4*n) = (/"m/s", "m/s", "kN ", "kN "/) enddo endif + + ! Initialize module variables + CALL IceFloe_InitVars(u, p, x, y, m, InitOut%Vars, .false., ErrStat, ErrMsg) + call iceErrorHndlr (iceLog, ErrStat, 'Error in allocation of output memory', 1) + if (ErrStat >= AbortErrLev) return ! Let the user know if there have been warnings if (iceLog%WarnFlag) then @@ -364,6 +370,55 @@ SUBROUTINE IceFloe_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In END SUBROUTINE IceFloe_Init + +subroutine IceFloe_InitVars(u, p, x, y, m, Vars, Linearize, ErrStat, ErrMsg) + type(IceFloe_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(IceFloe_ParameterType), intent(inout) :: p !< Parameters + type(IceFloe_ContinuousStateType), intent(inout) :: x !< Continuous state + type(IceFloe_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(IceFloe_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(ModVarsType), intent(inout) :: Vars !< Module variables + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_No ne + + character(*), parameter :: RoutineName = 'IceFloe_InitVars' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Initialization dependent on linearization + !---------------------------------------------------------------------------- + + call MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + call IceFloe_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call IceFloe_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call IceFloe_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call IceFloe_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE IceFloe_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ! diff --git a/modules/icefloe/src/interfaces/FAST/IceFloe_FASTRegistry.inp b/modules/icefloe/src/interfaces/FAST/IceFloe_FASTRegistry.inp index 362c9f02b3..e3f23ca0d3 100644 --- a/modules/icefloe/src/interfaces/FAST/IceFloe_FASTRegistry.inp +++ b/modules/icefloe/src/interfaces/FAST/IceFloe_FASTRegistry.inp @@ -25,6 +25,7 @@ typedef ^ ^ character(1024) RootName - - - "Output file root typedef IceFloe InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - typedef IceFloe InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - typedef IceFloe InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - +typedef IceFloe InitOutputType ModVarsType Vars - - - "Module Variables" # ..... States .................................................................................................................... # Define continuous (differentiable) states here: @@ -39,11 +40,6 @@ typedef IceFloe ConstraintStateType SiKi DummyConstrStateVar - - - "None curre # Define any other states, including integer or logical states here: typedef IceFloe OtherStateType IntKi DummyOtherState - - - "Remove this variable if you have other states" - -# ..... Misc/Optimization variables................................................................................................. -# Define any data that are used only for efficiency purposes (these variables are not associated with time): -# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. -typedef IceFloe MiscVarType IntKi DummyMiscVar - - - "Remove this variable if you have misc/optimization variables" - - # ..... Parameters ................................................................................................................ # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: @@ -75,3 +71,13 @@ typedef IceFloe InputType MeshType iceMesh - - - "Horizontal velocit # Define outputs that are contained on the mesh here: typedef IceFloe OutputType MeshType iceMesh - - - "Horizontal forces and torsional moment(s) on support structure leg(s) at water line" - typedef IceFloe OutputType ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" + +# ..... Misc/Optimization variables................................................................................................. +# Define any data that are used only for efficiency purposes (these variables are not associated with time): +# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. +typedef IceFloe MiscVarType IntKi DummyMiscVar - - - "Remove this variable if you have misc/optimization variables" - +typedef ^ ^ ModJacType Jac - - - Values corresponding to module variables" +typedef ^ ^ IceFloe_ContinuousStateType x_perturb - - - "" - +typedef ^ ^ IceFloe_ContinuousStateType dxdt_lin - - - "" - +typedef ^ ^ IceFloe_InputType u_perturb - - - "" - +typedef ^ ^ IceFloe_OutputType y_lin - - - "" - diff --git a/modules/inflowwind/src/IfW_FlowField.f90 b/modules/inflowwind/src/IfW_FlowField.f90 index 546359d16e..4b04737dc1 100644 --- a/modules/inflowwind/src/IfW_FlowField.f90 +++ b/modules/inflowwind/src/IfW_FlowField.f90 @@ -26,7 +26,6 @@ module IfW_FlowField public IfW_FlowField_GetVelAcc public IfW_UniformField_CalcAccel, IfW_Grid3DField_CalcAccel -public IfW_UniformWind_GetOP, IfW_UniformWind_Perturb ! for linearization public Grid3D_to_Uniform, Uniform_to_Grid3D integer(IntKi), parameter :: WindProfileType_None = -1 !< don't add wind profile; already included in input @@ -710,41 +709,6 @@ subroutine CalcCubicSplineDeriv(x, y, dy) end subroutine -!> Routine to compute the Jacobians of the output (Y) function with respect to the inputs (u). The partial -!! derivative dY/du is returned. This submodule does not follow the modularization framework. -subroutine IfW_UniformWind_GetOP(UF, t, InterpCubic, OP_out) - type(UniformFieldType), intent(IN) :: UF !< Parameters - real(DbKi), intent(IN) :: t !< Current simulation time in seconds - logical, intent(in) :: InterpCubic !< flag for using cubic interpolation - real(ReKi), intent(OUT) :: OP_out(3) !< operating point (HWindSpeed, PLexp, and AngleH) - - type(UniformField_Interp) :: op ! interpolated values of InterpParams - - ! Linearly interpolate parameters in time at operating point (or use nearest-neighbor to extrapolate) - if (InterpCubic) then - op = UniformField_InterpCubic(UF, t) - else - op = UniformField_InterpLinear(UF, t) - end if - - OP_out(1) = op%VelH - OP_out(2) = op%ShrV - OP_out(3) = op%AngleH -end subroutine - - -!> Routine to perturb the wind extended outputs (needed by AeroDyn) -!! NOTE: we are not passing the pointer here, but doing pass by reference to the FlowField since -!! this can only be used with linearization, and linearization requires using Uniform winds. -subroutine IfW_UniformWind_Perturb(FF_perturb, du) - type(FlowFieldType), intent(INOUT) :: FF_perturb !< Parameters to be modified - real(R8Ki), intent(IN ) :: du(3) !< perturbations to apply - FF_perturb%Uniform%VelH(:) = FF_perturb%Uniform%VelH(:) + du(1) - FF_perturb%Uniform%ShrV(:) = FF_perturb%Uniform%ShrV(:) + du(2) - FF_perturb%PropagationDir = FF_perturb%PropagationDir + du(3) -end subroutine - - subroutine Grid3DField_GetCell(G3D, Time, Position, CalcAccel, AllowExtrap, & VelCell, AccCell, Xi, Is3D, ErrStat, ErrMsg) diff --git a/modules/inflowwind/src/IfW_FlowField_Types.f90 b/modules/inflowwind/src/IfW_FlowField_Types.f90 index 5ffe11616d..6a5e024e7b 100644 --- a/modules/inflowwind/src/IfW_FlowField_Types.f90 +++ b/modules/inflowwind/src/IfW_FlowField_Types.f90 @@ -33,12 +33,12 @@ MODULE IfW_FlowField_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: Undef_FieldType = 0 ! This is the code for an undefined FieldType [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Uniform_FieldType = 1 ! Uniform FieldType from SteadyWind or Uniform Wind [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Grid3D_FieldType = 2 ! 3D Grid FieldType from TurbSim, Bladed, HAWC [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Grid4D_FieldType = 3 ! 4D Grid FieldType from FAST.Farm [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Point_FieldType = 4 ! Points FieldType from ExtInflow [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: User_FieldType = 5 ! User FieldType configured by the user [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Undef_FieldType = 0 ! This is the code for an undefined FieldType [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Uniform_FieldType = 1 ! Uniform FieldType from SteadyWind or Uniform Wind [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Grid3D_FieldType = 2 ! 3D Grid FieldType from TurbSim, Bladed, HAWC [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Grid4D_FieldType = 3 ! 4D Grid FieldType from FAST.Farm [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Point_FieldType = 4 ! Points FieldType from ExtInflow [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: User_FieldType = 5 ! User FieldType configured by the user [-] ! ========= UniformFieldType ======= TYPE, PUBLIC :: UniformFieldType REAL(ReKi) :: RefHeight = 0.0_ReKi !< reference height; used to center the wind [meters] @@ -164,7 +164,8 @@ MODULE IfW_FlowField_Types TYPE(UserFieldType) :: User !< User Field Wind Data [-] END TYPE FlowFieldType ! ======================= -CONTAINS + +contains subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUniformFieldTypeData, CtrlCode, ErrStat, ErrMsg) type(UniformFieldType), intent(in) :: SrcUniformFieldTypeData @@ -1085,5 +1086,7 @@ subroutine IfW_FlowField_UnPackFlowFieldType(RF, OutData) call IfW_FlowField_UnpackPointsFieldType(RF, OutData%Points) ! Points call IfW_FlowField_UnpackUserFieldType(RF, OutData%User) ! User end subroutine + END MODULE IfW_FlowField_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/InflowWind.f90 b/modules/inflowwind/src/InflowWind.f90 index de2d713a3b..ac70d0e1b9 100644 --- a/modules/inflowwind/src/InflowWind.f90 +++ b/modules/inflowwind/src/InflowWind.f90 @@ -57,7 +57,8 @@ MODULE InflowWind PUBLIC :: InflowWind_JacobianPContState PUBLIC :: InflowWind_JacobianPDiscState PUBLIC :: InflowWind_JacobianPConstrState - PUBLIC :: InflowWind_GetOP + PUBLIC :: InflowWind_PackExtInputAry + PUBLIC :: InflowWind_PackExtOutputAry CONTAINS !==================================================================================================== @@ -456,6 +457,13 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, Cons InitOutData%WriteOutputHdr = p%OutParam(1:p%NumOuts)%Name InitOutData%WriteOutputUnt = p%OutParam(1:p%NumOuts)%Units + !---------------------------------------------------------------------------- + ! Module Variables + !---------------------------------------------------------------------------- + + call IfW_InitVars(InitOutData%Vars, InitInp, p, y, m, InitOutData, InitInp%Linearize, TmpErrStat, TmpErrMsg) + call SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) + !---------------------------------------------------------------------------- ! Linearization !---------------------------------------------------------------------------- @@ -537,6 +545,84 @@ logical function Failed() end function Failed END SUBROUTINE InflowWind_Init +subroutine IfW_InitVars(Vars, InitInp, p, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(ModVarsType), intent(out) :: Vars !< Module variables + type(InflowWind_InitInputType), intent(in) :: InitInp !< Initialization input + type(InflowWind_ParameterType), intent(inout) :: p !< Parameters + type(InflowWind_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(InflowWind_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(InflowWind_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'MAP_InitVars' + integer(IntKi) :: ErrStat2 ! Temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + integer(IntKi) :: i + real(R8Ki) :: Perturb + + ErrStat = ErrID_None + ErrMsg = "" + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + call MV_AddVar(Vars%u, "HWindSpeed", FieldScalar, DatLoc(InflowWind_u_HWindSpeed), & + Flags=ior(VF_ExtLin, VF_Linearize), & + LinNames=['Extended input: horizontal wind speed (steady/uniform wind) (hub), m/s']) + + call MV_AddVar(Vars%u, "PLExp", FieldScalar, DatLoc(InflowWind_u_PLExp), & + Flags=ior(VF_ExtLin, VF_Linearize), & + LinNames=['Extended input: vertical power-law shear exponent (hub), -']) + + call MV_AddVar(Vars%u, "PropagationDir", FieldScalar, DatLoc(InflowWind_u_PropagationDir), & + Flags=ior(VF_ExtLin, VF_Linearize), & + LinNames=['Extended input: propagation direction (hub), rad']) + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + call MV_AddVar(Vars%y, "HWindSpeed", FieldScalar, DatLoc(InflowWind_y_HWindSpeed), & + Flags=VF_ExtLin, & + LinNames=['Extended output: horizontal wind speed (steady/uniform wind) (hub), m/s']) + + call MV_AddVar(Vars%y, "PLExp", FieldScalar, DatLoc(InflowWind_y_PLExp), & + Flags=VF_ExtLin, & + LinNames=['Extended output: vertical power-law shear exponent (hub), -']) + + call MV_AddVar(Vars%y, "PropagationDir", FieldScalar, DatLoc(InflowWind_y_PropagationDir), & + Flags=VF_ExtLin, & + LinNames=['Extended output: propagation direction (hub), rad']) + + call MV_AddVar(Vars%y, "WriteOutput", FieldScalar, DatLoc(InflowWind_y_WriteOutput), & + Flags=VF_WriteOut, & + Num=p%NumOuts, & + LinNames=[(WriteOutputLinName(i), i = 1, p%NumOuts)]) + + !---------------------------------------------------------------------------- + ! Initialize Variables and Jacobian data + !---------------------------------------------------------------------------- + + CALL MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + +contains + character(LinChanLen) function WriteOutputLinName(idx) + integer(IntKi), intent(in) :: idx + WriteOutputLinName = trim(InitOut%WriteOutputHdr(idx))//', '//trim(InitOut%WriteOutputUnt(idx)) + end function + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + !==================================================================================================== !> This routine takes an input dataset of type InputType which contains a position array of dimensions 3*n. It then calculates @@ -686,7 +772,8 @@ END SUBROUTINE InflowWind_End !---------------------------------------------------------------------------------------------------------------------------------- !> 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 InflowWind_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu ) +SUBROUTINE InflowWind_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu ) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module information REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(InflowWind_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters @@ -703,20 +790,21 @@ SUBROUTINE InflowWind_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrSt REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) - ! local variables: - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary error message - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_JacobianPInput' - REAL(R8Ki) :: local_dYdu(3,NumExtendedIO) - integer :: i,j, n - integer :: i_start, i_end ! indices for input/output start and end - integer :: node, comp + CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_JacobianPInput' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary error message + REAL(R8Ki) :: local_dYdu(3, NumExtendedIO) + integer :: i, j, n + integer :: i_start, i_end ! indices for input/output start and end + integer :: node, comp - ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' - IF ( PRESENT( dYdu ) ) THEN + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + ! - inputs are extended inputs only + ! - outputs are the extended outputs and the WriteOutput values + if (present(dYdu)) then ! If dYdu is allocated, make sure it is the correct size if (allocated(dYdu)) then @@ -724,54 +812,59 @@ SUBROUTINE InflowWind_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrSt if (size(dYdu,2) /= NumExtendedIO) deallocate (dYdu) endif - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: - ! - inputs are extended inputs only - ! - outputs are the extended outputs and the WriteOutput values - if (.not. ALLOCATED(dYdu)) then - CALL AllocAry( dYdu, NumExtendedIO + p%NumOuts, NumExtendedIO, 'dYdu', ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (.not. allocated(dYdu)) then + call AllocAry(dYdu, NumExtendedIO + p%NumOuts, NumExtendedIO, 'dYdu', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end if - - SELECT CASE ( p%FlowField%FieldType ) - CASE (Uniform_FieldType) - dYdu = 0.0_R8Ki ! initialize all non-diagonal entries to zero (position of node effects the output of only that node) + ! Switch based on type of flowfield + select case (p%FlowField%FieldType) + case (Uniform_FieldType) + + ! Initialize all non-diagonal entries to zero (position of node effects the output of only that node) + dYdu = 0.0_R8Ki ! Extended inputs to extended outputs (direct pass-through) - do i=1,NumExtendedIO + do i = 1, NumExtendedIO dYdu(i,i) = 1.0_R8Ki enddo ! WriteOutput velocities (note: may not have all of the components of each point) - do i=1, p%NumOuts + do i = 1, p%NumOuts + node = p%OutParamLinIndx(1,i) ! output node comp = p%OutParamLinIndx(2,i) ! component of output node if (node > 0) then - call IfW_UniformWind_JacobianPInput( p%FlowField%Uniform, t, p%WindViXYZ(:,node), p%FlowField%RotToWind(1,1), p%FlowField%RotToWind(2,1), local_dYdu ) + call IfW_UniformWind_JacobianPInput(p%FlowField%Uniform, t, p%WindViXYZ(:,node), & + p%FlowField%RotToWind(1,1), & + p%FlowField%RotToWind(2,1), & + local_dYdu) else local_dYdu = 0.0_R8Ki comp = 1 end if - dYdu(NumExtendedIO+i, 1:NumExtendedIO) = p%OutParam(i)%SignM * local_dYdu( comp , 1:NumExtendedIO) + + dYdu(NumExtendedIO+i, 1:NumExtendedIO) = p%OutParam(i)%SignM * local_dYdu(comp, 1:NumExtendedIO) + end do - CASE DEFAULT - END SELECT - END IF + end select + end if - IF ( PRESENT( dXdu ) ) THEN + if (present(dXdu)) then if (allocated(dXdu)) deallocate(dXdu) - END IF + end if - IF ( PRESENT( dXddu ) ) THEN + if (present(dXddu)) then if (allocated(dXddu)) deallocate(dXddu) - END IF + end if - IF ( PRESENT( dZdu ) ) THEN + if (present(dZdu)) then if (allocated(dZdu)) deallocate(dZdu) - END IF + end if + END SUBROUTINE InflowWind_JacobianPInput @@ -860,7 +953,8 @@ END SUBROUTINE IfW_UniformWind_JacobianPInput !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. !! Note: there are no states, so this routine is simply a placeholder to satisfy the framework and automate some glue code -SUBROUTINE InflowWind_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) +SUBROUTINE InflowWind_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(InflowWind_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters @@ -881,7 +975,6 @@ SUBROUTINE InflowWind_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, E ErrStat = ErrID_None ErrMsg = '' - return ! IF ( PRESENT( dYdx ) ) THEN ! END IF ! IF ( PRESENT( dXdx ) ) THEN @@ -895,7 +988,8 @@ END SUBROUTINE InflowWind_JacobianPContState !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the discrete states (xd). The partial derivatives dY/dxd, dX/dxd, dXd/dxd, and dZ/dxd are returned. !! Note: there are no states, so this routine is simply a placeholder to satisfy the framework and automate some glue code -SUBROUTINE InflowWind_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) +SUBROUTINE InflowWind_JacobianPDiscState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(InflowWind_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters @@ -916,8 +1010,6 @@ SUBROUTINE InflowWind_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, E ErrStat = ErrID_None ErrMsg = '' - return - ! IF ( PRESENT( dYdxd ) ) THEN ! END IF ! IF ( PRESENT( dXdxd ) ) THEN @@ -931,7 +1023,8 @@ END SUBROUTINE InflowWind_JacobianPDiscState !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the constraint states (z). The partial derivatives dY/dz, dX/dz, dXd/dz, and dZ/dz are returned. !! Note: there are no states, so this routine is simply a placeholder to satisfy the framework and automate some glue code -SUBROUTINE InflowWind_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) +SUBROUTINE InflowWind_JacobianPConstrState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(InflowWind_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters @@ -952,8 +1045,6 @@ SUBROUTINE InflowWind_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat = ErrID_None ErrMsg = '' - return - ! IF ( PRESENT( dYdz ) ) THEN ! END IF ! IF ( PRESENT( dXdz ) ) THEN @@ -963,78 +1054,89 @@ SUBROUTINE InflowWind_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ! IF ( PRESENT( dZdz ) ) THEN ! END IF END SUBROUTINE InflowWind_JacobianPConstrState -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE InflowWind_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(InflowWind_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(InflowWind_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(InflowWind_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(InflowWind_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(InflowWind_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(InflowWind_OutputType), INTENT(IN ) :: y !< Output at operating point - TYPE(InflowWind_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - - INTEGER(IntKi) :: i - real(ReKi) :: tmp_op(NumExtendedIO) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_GetOP' - - - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = '' - - ! Since both u_op and y_op need this, calculate it up front - if (present(u_op) .or. present(y_op)) then - call IfW_UniformWind_GetOP( p%FlowField%Uniform, t, p%FlowField%VelInterpCubic, tmp_op ) - tmp_op(3) = p%FlowField%PropagationDir + tmp_op(3) ! include the AngleH from Uniform Wind input files - endif - if ( PRESENT( u_op ) ) then - if (.not. allocated(u_op)) then - call AllocAry(u_op, NumExtendedIO, 'u_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return +subroutine InflowWind_PackExtInputAry(Vars, t, p, ValAry) + type(ModVarsType), intent(in) :: Vars + real(DbKi), intent(in) :: t !< Time in seconds at operating point + type(InflowWind_ParameterType), intent(in) :: p !< Parameters + real(R8Ki), intent(inout) :: ValAry(:) + type(UniformField_Interp) :: op !< Interpolated values of UniformField + integer(IntKi) :: i + logical :: first + first = .true. + do i = 1, size(Vars%u) + associate(Var => Vars%u(i)) + select case(Var%DL%Num) + case (InflowWind_u_HWindSpeed) + call CalcExtOP() + ValAry(Var%iLoc(1)) = op%VelH + case (InflowWind_u_PLExp) + call CalcExtOP() + ValAry(Var%iLoc(1)) = op%ShrV + case (InflowWind_u_PropagationDir) + call CalcExtOP() + ValAry(Var%iLoc(1)) = op%AngleH + p%FlowField%PropagationDir + end select + end associate + end do +contains + subroutine CalcExtOP() + if (.not. first) return + first = .false. + if (p%FlowField%FieldType == Uniform_FieldType) then + if (P%FlowField%VelInterpCubic) then + op = UniformField_InterpCubic(p%FlowField%Uniform, t) + else + op = UniformField_InterpLinear(p%FlowField%Uniform, t) + end if + else + op%VelH = 0.0_ReKi + op%ShrV = 0.0_ReKi + op%AngleH = 0.0_ReKi end if - - u_op(1:NumExtendedIO) = tmp_op(1:NumExtendedIO) - - end if - - if ( PRESENT( y_op ) ) then - if (.not. allocated(y_op)) then - call AllocAry(y_op, NumExtendedIO + p%NumOuts, 'y_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return + end subroutine +end subroutine + +subroutine InflowWind_PackExtOutputAry(Vars, t, p, ValAry) + type(ModVarsType), intent(in) :: Vars + real(DbKi), intent(in) :: t !< Time in seconds at operating point + type(InflowWind_ParameterType), intent(in) :: p !< Parameters + real(R8Ki), intent(inout) :: ValAry(:) + type(UniformField_Interp) :: op !< Interpolated values of UniformField + integer(IntKi) :: i + logical :: first + first = .true. + do i = 1, size(Vars%y) + associate(Var => Vars%y(i)) + select case(Var%DL%Num) + case (InflowWind_y_HWindSpeed) + call CalcExtOP() + ValAry(Var%iLoc(1)) = op%VelH + case (InflowWind_y_PLExp) + call CalcExtOP() + ValAry(Var%iLoc(1)) = op%ShrV + case (InflowWind_y_PropagationDir) + call CalcExtOP() + ValAry(Var%iLoc(1)) = op%AngleH + p%FlowField%PropagationDir + end select + end associate + end do +contains + subroutine CalcExtOP() + if (.not. first) return + first = .false. + if (p%FlowField%FieldType == Uniform_FieldType) then + if (P%FlowField%VelInterpCubic) then + op = UniformField_InterpCubic(p%FlowField%Uniform, t) + else + op = UniformField_InterpLinear(p%FlowField%Uniform, t) + end if + else + op%VelH = 0.0_ReKi + op%ShrV = 0.0_ReKi + op%AngleH = 0.0_ReKi end if - - y_op(1:NumExtendedIO) = tmp_op(1:NumExtendedIO) - do i=1,p%NumOuts - y_op(NumExtendedIO + i) = y%WriteOutput( i ) - end do - end if - - return - -! IF ( PRESENT( x_op ) ) THEN -! END IF -! IF ( PRESENT( dx_op ) ) THEN -! END IF -! IF ( PRESENT( xd_op ) ) THEN -! END IF -! IF ( PRESENT( z_op ) ) THEN -! END IF -END SUBROUTINE InflowWind_GetOP + end subroutine +end subroutine END MODULE InflowWind diff --git a/modules/inflowwind/src/InflowWind.txt b/modules/inflowwind/src/InflowWind.txt index 924573b8f5..8f8d63cddb 100644 --- a/modules/inflowwind/src/InflowWind.txt +++ b/modules/inflowwind/src/InflowWind.txt @@ -28,6 +28,13 @@ param ^ - IntKi Highest_Win param ^ - IntKi IfW_NumPtsAvg - 144 - "Number of points averaged for rotor-average wind speed" - +param ^ - IntKi InflowWind_u_HWindSpeed - -1 - "DatLoc number for HWindSpeed extended input" - +param ^ - IntKi InflowWind_u_PLExp - -2 - "DatLoc number for PLExp extended input" - +param ^ - IntKi InflowWind_u_PropagationDir - -3 - "DatLoc number for PropagationDir extended input" - +param ^ - IntKi InflowWind_y_HWindSpeed - -4 - "DatLoc number for HWindSpeed extended output" - +param ^ - IntKi InflowWind_y_PLExp - -5 - "DatLoc number for PLExp extended output" - +param ^ - IntKi InflowWind_y_PropagationDir - -6 - "DatLoc number for PropagationDir extended output" - + ######################### # ..... Input file data ........................................................................................................... # This is data defined in the Input File for this module (or could otherwise be passed in) @@ -112,7 +119,8 @@ typedef ^ ^ CHARACTER(LinChanLen) LinNam typedef ^ ^ LOGICAL RotFrame_y {:} - - "Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame" - typedef ^ ^ LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - typedef ^ ^ LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - -typedef ^ ^ FlowFieldType *FlowField - - - "Flow field data to represent all wind types" - +typedef ^ ^ FlowFieldType *FlowField - - - "Flow field data to represent all wind types" - +typedef ^ ^ ModVarsType Vars - - - "Module Variables" # ..... Parameters ................................................................................................................ @@ -168,3 +176,4 @@ typedef ^ ^ InflowWind_InputType u_Avg typedef ^ ^ InflowWind_OutputType y_Avg - - - "outputs for computing rotor-averaged values" - typedef ^ ^ InflowWind_InputType u_Hub - - - "inputs for computing hub values" - typedef ^ ^ InflowWind_OutputType y_Hub - - - "outputs for computing hub values" - +typedef ^ ^ ModJacType Jac - - - "Values corresponding to module variables" - diff --git a/modules/inflowwind/src/InflowWind_Driver_Types.f90 b/modules/inflowwind/src/InflowWind_Driver_Types.f90 index 6768f63819..70d5f39cb3 100644 --- a/modules/inflowwind/src/InflowWind_Driver_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Driver_Types.f90 @@ -98,7 +98,8 @@ MODULE InflowWind_Driver_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutWindX !< X coordinates of YZ planes for output [1 to NOutWindYZ] [unused for NOutWindYZ=0] [(m)] END TYPE IfWDriver_Settings ! ======================= -CONTAINS + +contains subroutine InflowWind_Driver_CopyOutputFile(SrcOutputFileData, DstOutputFileData, CtrlCode, ErrStat, ErrMsg) type(OutputFile), intent(in) :: SrcOutputFileData @@ -429,5 +430,7 @@ subroutine InflowWind_Driver_UnPackIfWDriver_Settings(RF, OutData) call RegUnpack(RF, OutData%NOutWindYZ); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%OutWindX); if (RegCheckErr(RF, RoutineName)) return end subroutine + END MODULE InflowWind_Driver_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/InflowWind_IO.f90 b/modules/inflowwind/src/InflowWind_IO.f90 index afd7281002..23be57bb8f 100644 --- a/modules/inflowwind/src/InflowWind_IO.f90 +++ b/modules/inflowwind/src/InflowWind_IO.f90 @@ -34,7 +34,8 @@ module InflowWind_IO IfW_HAWC_Init, & IfW_User_Init, & IfW_Grid4D_Init, & - IfW_Points_Init + IfW_Points_Init, & + IfW_SteadyFlowField_Init public :: Uniform_WriteHH, & Grid3D_WriteBladed, & @@ -87,7 +88,7 @@ subroutine IfW_SteadyWind_Init(InitInp, SumFileUnit, UF, FileDat, ErrStat, ErrMs ErrStat = ErrID_None ErrMsg = "" - ! Set parameters from inititialization input + ! Set parameters from initialization input UF%DataSize = 1 UF%RefHeight = InitInp%RefHt UF%RefLength = 1.0_ReKi @@ -152,6 +153,73 @@ subroutine IfW_SteadyWind_Init(InitInp, SumFileUnit, UF, FileDat, ErrStat, ErrMs end subroutine +subroutine IfW_SteadyFlowField_Init(FF, RefHt, HWindSpeed, PLExp, ErrStat, ErrMsg, AngleH) + use InflowWind_IO_Types, only: Steady_InitInputType, WindFileDat + type(FlowFieldType), pointer, intent(inout) :: FF !< FlowField + real(ReKi), intent(in) :: RefHt !< Hub reference height + real(ReKi), intent(in) :: HWindSpeed !< Horizontal wind speed at reference height + real(ReKi), intent(in) :: PLExp !< Power law shear coefficient + integer(IntKi), intent(out) :: ErrStat !< Error status + character(*), intent(out) :: ErrMsg !< Error message + real(ReKi), optional, intent(in) :: AngleH !< Horizontal angle + + character(*), parameter :: RoutineName = 'IfW_SteadyFlowField_Init' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + type(Steady_InitInputType) :: InitInp + type(WindFileDat) :: WFileDat + + ErrStat = ErrID_None + ErrMsg = "" + + ! If FlowField pointer is already associated, destroy existing flow field; + ! otherwise, allocate a new flow field for pointer + if (associated(FF)) then + call IfW_FlowField_DestroyFlowFieldType(FF, ErrStat2, ErrMsg2); if (Failed()) return + else + allocate(FF, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating flow field', ErrStat, ErrMsg, RoutineName) + return + end if + end if + + ! Set flow-field type to uniform + FF%FieldType = Uniform_FieldType + + ! Set parameters from initialization input + FF%Uniform%DataSize = 1 + FF%Uniform%RefHeight = RefHt + FF%Uniform%RefLength = 1.0_ReKi + + ! Allocate uniform wind data arrays + call UniformWind_AllocArrays(FF%Uniform, ErrStat2, ErrMsg2); if (Failed()) return + + ! Set data values + FF%Uniform%Time = 0.0_ReKi + FF%Uniform%VelH = HWindSpeed + FF%Uniform%VelV = 0.0_ReKi + FF%Uniform%VelGust = 0.0_ReKi + if (present(AngleH)) then + FF%Uniform%AngleH = AngleH + else + FF%Uniform%AngleH = 0.0_ReKi + end if + FF%Uniform%AngleV = 0.0_ReKi + FF%Uniform%ShrH = 0.0_ReKi + FF%Uniform%ShrV = PLExp + FF%Uniform%LinShrV = 0.0_ReKi + + + + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + !> IfW_UniformWind_Init initializes a Uniform field from file. subroutine IfW_UniformWind_Init(InitInp, SumFileUnit, UF, FileDat, ErrStat, ErrMsg) type(Uniform_InitInputType), intent(in) :: InitInp @@ -178,7 +246,7 @@ subroutine IfW_UniformWind_Init(InitInp, SumFileUnit, UF, FileDat, ErrStat, ErrM ErrStat = ErrID_None ErrMsg = "" - ! Set parameters from inititialization input + ! Set parameters from initialization input UF%RefHeight = InitInp%RefHt UF%RefLength = InitInp%RefLength diff --git a/modules/inflowwind/src/InflowWind_IO_Types.f90 b/modules/inflowwind/src/InflowWind_IO_Types.f90 index 7d88b26c34..5aa7e4da70 100644 --- a/modules/inflowwind/src/InflowWind_IO_Types.f90 +++ b/modules/inflowwind/src/InflowWind_IO_Types.f90 @@ -139,7 +139,8 @@ MODULE InflowWind_IO_Types INTEGER(IntKi) :: NumWindPoints = 0_IntKi !< Number of points where wind components will be provided [-] END TYPE Points_InitInputType ! ======================= -CONTAINS + +contains subroutine InflowWind_IO_CopyWindFileDat(SrcWindFileDatData, DstWindFileDatData, CtrlCode, ErrStat, ErrMsg) type(WindFileDat), intent(in) :: SrcWindFileDatData @@ -725,5 +726,7 @@ subroutine InflowWind_IO_UnPackPoints_InitInputType(RF, OutData) if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%NumWindPoints); if (RegCheckErr(RF, RoutineName)) return end subroutine + END MODULE InflowWind_IO_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index 646d366064..33a0b33f76 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -36,18 +36,24 @@ MODULE InflowWind_Types USE Lidar_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: Undef_WindNumber = 0 ! This is the code for an undefined WindFileType [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Steady_WindNumber = 1 ! Steady wind. Calculated internally. [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Uniform_WindNumber = 2 ! Uniform wind. Formally known as a Hub-Height wind file. [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: TSFF_WindNumber = 3 ! TurbSim full-field binary file. [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BladedFF_WindNumber = 4 ! Bladed style binary full-field file. Includes native bladed format [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: HAWC_WindNumber = 5 ! HAWC wind file. [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: User_WindNumber = 6 ! User defined wind. [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BladedFF_Shr_WindNumber = 7 ! Native Bladed binary full-field file. [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: FDext_WindNumber = 8 ! 4D wind from external souce (i.e., FAST.Farm). [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Point_WindNumber = 9 ! 1D wind components from ExtInflow [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Highest_WindNumber = 9 ! Highest wind number supported. [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: IfW_NumPtsAvg = 144 ! Number of points averaged for rotor-average wind speed [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Undef_WindNumber = 0 ! This is the code for an undefined WindFileType [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Steady_WindNumber = 1 ! Steady wind. Calculated internally. [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Uniform_WindNumber = 2 ! Uniform wind. Formally known as a Hub-Height wind file. [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TSFF_WindNumber = 3 ! TurbSim full-field binary file. [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BladedFF_WindNumber = 4 ! Bladed style binary full-field file. Includes native bladed format [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: HAWC_WindNumber = 5 ! HAWC wind file. [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: User_WindNumber = 6 ! User defined wind. [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BladedFF_Shr_WindNumber = 7 ! Native Bladed binary full-field file. [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FDext_WindNumber = 8 ! 4D wind from external souce (i.e., FAST.Farm). [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Point_WindNumber = 9 ! 1D wind components from ExtInflow [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Highest_WindNumber = 9 ! Highest wind number supported. [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: IfW_NumPtsAvg = 144 ! Number of points averaged for rotor-average wind speed [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: InflowWind_u_HWindSpeed = -1 ! DatLoc number for HWindSpeed extended input [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: InflowWind_u_PLExp = -2 ! DatLoc number for PLExp extended input [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: InflowWind_u_PropagationDir = -3 ! DatLoc number for PropagationDir extended input [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: InflowWind_y_HWindSpeed = -4 ! DatLoc number for HWindSpeed extended output [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: InflowWind_y_PLExp = -5 ! DatLoc number for PLExp extended output [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: InflowWind_y_PropagationDir = -6 ! DatLoc number for PropagationDir extended output [-] ! ========= InflowWind_InputFile ======= TYPE, PUBLIC :: InflowWind_InputFile LOGICAL :: EchoFlag = .false. !< Echo the input file [-] @@ -133,6 +139,7 @@ MODULE InflowWind_Types LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Flow field data to represent all wind types [-] + TYPE(ModVarsType) :: Vars !< Module Variables [-] END TYPE InflowWind_InitOutputType ! ======================= ! ========= InflowWind_ParameterType ======= @@ -198,9 +205,31 @@ MODULE InflowWind_Types TYPE(InflowWind_OutputType) :: y_Avg !< outputs for computing rotor-averaged values [-] TYPE(InflowWind_InputType) :: u_Hub !< inputs for computing hub values [-] TYPE(InflowWind_OutputType) :: y_Hub !< outputs for computing hub values [-] + TYPE(ModJacType) :: Jac !< Values corresponding to module variables [-] END TYPE InflowWind_MiscVarType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: InflowWind_x_DummyContState = 1 ! InflowWind%DummyContState + integer(IntKi), public, parameter :: InflowWind_z_DummyConstrState = 2 ! InflowWind%DummyConstrState + integer(IntKi), public, parameter :: InflowWind_u_PositionXYZ = 3 ! InflowWind%PositionXYZ + integer(IntKi), public, parameter :: InflowWind_u_lidar_PulseLidEl = 4 ! InflowWind%lidar%PulseLidEl + integer(IntKi), public, parameter :: InflowWind_u_lidar_PulseLidAz = 5 ! InflowWind%lidar%PulseLidAz + integer(IntKi), public, parameter :: InflowWind_u_lidar_HubDisplacementX = 6 ! InflowWind%lidar%HubDisplacementX + integer(IntKi), public, parameter :: InflowWind_u_lidar_HubDisplacementY = 7 ! InflowWind%lidar%HubDisplacementY + integer(IntKi), public, parameter :: InflowWind_u_lidar_HubDisplacementZ = 8 ! InflowWind%lidar%HubDisplacementZ + integer(IntKi), public, parameter :: InflowWind_u_HubPosition = 9 ! InflowWind%HubPosition + integer(IntKi), public, parameter :: InflowWind_u_HubOrientation = 10 ! InflowWind%HubOrientation + integer(IntKi), public, parameter :: InflowWind_y_VelocityUVW = 11 ! InflowWind%VelocityUVW + integer(IntKi), public, parameter :: InflowWind_y_AccelUVW = 12 ! InflowWind%AccelUVW + integer(IntKi), public, parameter :: InflowWind_y_WriteOutput = 13 ! InflowWind%WriteOutput + integer(IntKi), public, parameter :: InflowWind_y_DiskVel = 14 ! InflowWind%DiskVel + integer(IntKi), public, parameter :: InflowWind_y_HubVel = 15 ! InflowWind%HubVel + integer(IntKi), public, parameter :: InflowWind_y_lidar_LidSpeed = 16 ! InflowWind%lidar%LidSpeed + integer(IntKi), public, parameter :: InflowWind_y_lidar_WtTrunc = 17 ! InflowWind%lidar%WtTrunc + integer(IntKi), public, parameter :: InflowWind_y_lidar_MsrPositionsX = 18 ! InflowWind%lidar%MsrPositionsX + integer(IntKi), public, parameter :: InflowWind_y_lidar_MsrPositionsY = 19 ! InflowWind%lidar%MsrPositionsY + integer(IntKi), public, parameter :: InflowWind_y_lidar_MsrPositionsZ = 20 ! InflowWind%lidar%MsrPositionsZ + +contains subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) type(InflowWind_InputFile), intent(in) :: SrcInputFileData @@ -700,6 +729,9 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if DstInitOutputData%FlowField => SrcInitOutputData%FlowField + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine InflowWind_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -737,6 +769,8 @@ subroutine InflowWind_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) deallocate(InitOutputData%IsLoad_u) end if nullify(InitOutputData%FlowField) + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine InflowWind_PackInitOutput(RF, Indata) @@ -761,6 +795,7 @@ subroutine InflowWind_PackInitOutput(RF, Indata) call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) end if end if + call NWTC_Library_PackModVarsType(RF, InData%Vars) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -801,6 +836,7 @@ subroutine InflowWind_UnPackInitOutput(RF, OutData) else OutData%FlowField => null() end if + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end subroutine subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -1427,6 +1463,9 @@ subroutine InflowWind_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrM call InflowWind_CopyOutput(SrcMiscData%y_Hub, DstMiscData%y_Hub, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine InflowWind_DestroyMisc(MiscData, ErrStat, ErrMsg) @@ -1455,6 +1494,8 @@ subroutine InflowWind_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call InflowWind_DestroyOutput(MiscData%y_Hub, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine InflowWind_PackMisc(RF, Indata) @@ -1469,6 +1510,7 @@ subroutine InflowWind_PackMisc(RF, Indata) call InflowWind_PackOutput(RF, InData%y_Avg) call InflowWind_PackInput(RF, InData%u_Hub) call InflowWind_PackOutput(RF, InData%y_Hub) + call NWTC_Library_PackModJacType(RF, InData%Jac) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1487,6 +1529,7 @@ subroutine InflowWind_UnPackMisc(RF, OutData) call InflowWind_UnpackOutput(RF, OutData%y_Avg) ! y_Avg call InflowWind_UnpackInput(RF, OutData%u_Hub) ! u_Hub call InflowWind_UnpackOutput(RF, OutData%y_Hub) ! y_Hub + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac end subroutine subroutine InflowWind_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) @@ -1848,5 +1891,373 @@ SUBROUTINE InflowWind_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrS 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 + +function InflowWind_InputMeshPointer(u, DL) result(Mesh) + type(InflowWind_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +function InflowWind_OutputMeshPointer(y, DL) result(Mesh) + type(InflowWind_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +subroutine InflowWind_VarsPackContState(Vars, x, ValAry) + type(InflowWind_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call InflowWind_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine InflowWind_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(InflowWind_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (InflowWind_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine InflowWind_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(InflowWind_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call InflowWind_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine InflowWind_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(InflowWind_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (InflowWind_x_DummyContState) + x%DummyContState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function InflowWind_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (InflowWind_x_DummyContState) + Name = "x%DummyContState" + case default + Name = "Unknown Field" + end select +end function + +subroutine InflowWind_VarsPackContStateDeriv(Vars, x, ValAry) + type(InflowWind_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call InflowWind_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine InflowWind_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(InflowWind_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (InflowWind_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine InflowWind_VarsPackConstrState(Vars, z, ValAry) + type(InflowWind_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call InflowWind_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine InflowWind_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(InflowWind_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (InflowWind_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine InflowWind_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(InflowWind_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call InflowWind_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine InflowWind_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(InflowWind_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (InflowWind_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function InflowWind_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (InflowWind_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine InflowWind_VarsPackInput(Vars, u, ValAry) + type(InflowWind_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call InflowWind_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine InflowWind_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(InflowWind_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (InflowWind_u_PositionXYZ) + VarVals = u%PositionXYZ(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (InflowWind_u_lidar_PulseLidEl) + VarVals(1) = u%lidar%PulseLidEl ! Scalar + case (InflowWind_u_lidar_PulseLidAz) + VarVals(1) = u%lidar%PulseLidAz ! Scalar + case (InflowWind_u_lidar_HubDisplacementX) + VarVals(1) = u%lidar%HubDisplacementX ! Scalar + case (InflowWind_u_lidar_HubDisplacementY) + VarVals(1) = u%lidar%HubDisplacementY ! Scalar + case (InflowWind_u_lidar_HubDisplacementZ) + VarVals(1) = u%lidar%HubDisplacementZ ! Scalar + case (InflowWind_u_HubPosition) + VarVals = u%HubPosition(V%iLB:V%iUB) ! Rank 1 Array + case (InflowWind_u_HubOrientation) + VarVals = u%HubOrientation(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine InflowWind_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(InflowWind_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call InflowWind_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine InflowWind_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(InflowWind_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (InflowWind_u_PositionXYZ) + u%PositionXYZ(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (InflowWind_u_lidar_PulseLidEl) + u%lidar%PulseLidEl = VarVals(1) ! Scalar + case (InflowWind_u_lidar_PulseLidAz) + u%lidar%PulseLidAz = VarVals(1) ! Scalar + case (InflowWind_u_lidar_HubDisplacementX) + u%lidar%HubDisplacementX = VarVals(1) ! Scalar + case (InflowWind_u_lidar_HubDisplacementY) + u%lidar%HubDisplacementY = VarVals(1) ! Scalar + case (InflowWind_u_lidar_HubDisplacementZ) + u%lidar%HubDisplacementZ = VarVals(1) ! Scalar + case (InflowWind_u_HubPosition) + u%HubPosition(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (InflowWind_u_HubOrientation) + u%HubOrientation(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + +function InflowWind_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (InflowWind_u_PositionXYZ) + Name = "u%PositionXYZ" + case (InflowWind_u_lidar_PulseLidEl) + Name = "u%lidar%PulseLidEl" + case (InflowWind_u_lidar_PulseLidAz) + Name = "u%lidar%PulseLidAz" + case (InflowWind_u_lidar_HubDisplacementX) + Name = "u%lidar%HubDisplacementX" + case (InflowWind_u_lidar_HubDisplacementY) + Name = "u%lidar%HubDisplacementY" + case (InflowWind_u_lidar_HubDisplacementZ) + Name = "u%lidar%HubDisplacementZ" + case (InflowWind_u_HubPosition) + Name = "u%HubPosition" + case (InflowWind_u_HubOrientation) + Name = "u%HubOrientation" + case default + Name = "Unknown Field" + end select +end function + +subroutine InflowWind_VarsPackOutput(Vars, y, ValAry) + type(InflowWind_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call InflowWind_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine InflowWind_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(InflowWind_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (InflowWind_y_VelocityUVW) + VarVals = y%VelocityUVW(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (InflowWind_y_AccelUVW) + VarVals = y%AccelUVW(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (InflowWind_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case (InflowWind_y_DiskVel) + VarVals = y%DiskVel(V%iLB:V%iUB) ! Rank 1 Array + case (InflowWind_y_HubVel) + VarVals = y%HubVel(V%iLB:V%iUB) ! Rank 1 Array + case (InflowWind_y_lidar_LidSpeed) + VarVals = y%lidar%LidSpeed(V%iLB:V%iUB) ! Rank 1 Array + case (InflowWind_y_lidar_WtTrunc) + VarVals = y%lidar%WtTrunc(V%iLB:V%iUB) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsX) + VarVals = y%lidar%MsrPositionsX(V%iLB:V%iUB) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsY) + VarVals = y%lidar%MsrPositionsY(V%iLB:V%iUB) ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsZ) + VarVals = y%lidar%MsrPositionsZ(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine InflowWind_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(InflowWind_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call InflowWind_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine InflowWind_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(InflowWind_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (InflowWind_y_VelocityUVW) + y%VelocityUVW(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (InflowWind_y_AccelUVW) + y%AccelUVW(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (InflowWind_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (InflowWind_y_DiskVel) + y%DiskVel(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (InflowWind_y_HubVel) + y%HubVel(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (InflowWind_y_lidar_LidSpeed) + y%lidar%LidSpeed(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (InflowWind_y_lidar_WtTrunc) + y%lidar%WtTrunc(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsX) + y%lidar%MsrPositionsX(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsY) + y%lidar%MsrPositionsY(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (InflowWind_y_lidar_MsrPositionsZ) + y%lidar%MsrPositionsZ(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function InflowWind_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (InflowWind_y_VelocityUVW) + Name = "y%VelocityUVW" + case (InflowWind_y_AccelUVW) + Name = "y%AccelUVW" + case (InflowWind_y_WriteOutput) + Name = "y%WriteOutput" + case (InflowWind_y_DiskVel) + Name = "y%DiskVel" + case (InflowWind_y_HubVel) + Name = "y%HubVel" + case (InflowWind_y_lidar_LidSpeed) + Name = "y%lidar%LidSpeed" + case (InflowWind_y_lidar_WtTrunc) + Name = "y%lidar%WtTrunc" + case (InflowWind_y_lidar_MsrPositionsX) + Name = "y%lidar%MsrPositionsX" + case (InflowWind_y_lidar_MsrPositionsY) + Name = "y%lidar%MsrPositionsY" + case (InflowWind_y_lidar_MsrPositionsZ) + Name = "y%lidar%MsrPositionsZ" + case default + Name = "Unknown Field" + end select +end function + END MODULE InflowWind_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index 8277eb6a54..4386b2bfbe 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -33,10 +33,10 @@ MODULE Lidar_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_None = 0 - INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_SinglePoint = 1 - INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_ContinuousLidar = 2 - INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_PulsedLidar = 3 + INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_None = 0 + INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_SinglePoint = 1 + INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_ContinuousLidar = 2 + INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_PulsedLidar = 3 ! ========= Lidar_InitInputType ======= TYPE, PUBLIC :: Lidar_InitInputType INTEGER(IntKi) :: SensorType = SensorType_None !< SensorType_* parameter [-] @@ -123,7 +123,20 @@ MODULE Lidar_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MsrPositionsZ !< Lidar Z direction measurement points [m] END TYPE Lidar_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: Lidar_x_DummyContState = 1 ! Lidar%DummyContState + integer(IntKi), public, parameter :: Lidar_z_DummyConstrState = 2 ! Lidar%DummyConstrState + integer(IntKi), public, parameter :: Lidar_u_PulseLidEl = 3 ! Lidar%PulseLidEl + integer(IntKi), public, parameter :: Lidar_u_PulseLidAz = 4 ! Lidar%PulseLidAz + integer(IntKi), public, parameter :: Lidar_u_HubDisplacementX = 5 ! Lidar%HubDisplacementX + integer(IntKi), public, parameter :: Lidar_u_HubDisplacementY = 6 ! Lidar%HubDisplacementY + integer(IntKi), public, parameter :: Lidar_u_HubDisplacementZ = 7 ! Lidar%HubDisplacementZ + integer(IntKi), public, parameter :: Lidar_y_LidSpeed = 8 ! Lidar%LidSpeed + integer(IntKi), public, parameter :: Lidar_y_WtTrunc = 9 ! Lidar%WtTrunc + integer(IntKi), public, parameter :: Lidar_y_MsrPositionsX = 10 ! Lidar%MsrPositionsX + integer(IntKi), public, parameter :: Lidar_y_MsrPositionsY = 11 ! Lidar%MsrPositionsY + integer(IntKi), public, parameter :: Lidar_y_MsrPositionsZ = 12 ! Lidar%MsrPositionsZ + +contains subroutine Lidar_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(Lidar_InitInputType), intent(in) :: SrcInitInputData @@ -1096,5 +1109,325 @@ SUBROUTINE Lidar_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, y_out%MsrPositionsZ = a1*y1%MsrPositionsZ + a2*y2%MsrPositionsZ + a3*y3%MsrPositionsZ END IF ! check if allocated END SUBROUTINE + +function Lidar_InputMeshPointer(u, DL) result(Mesh) + type(Lidar_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +function Lidar_OutputMeshPointer(y, DL) result(Mesh) + type(Lidar_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +subroutine Lidar_VarsPackContState(Vars, x, ValAry) + type(Lidar_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call Lidar_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine Lidar_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(Lidar_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Lidar_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Lidar_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Lidar_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call Lidar_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine Lidar_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Lidar_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Lidar_x_DummyContState) + x%DummyContState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function Lidar_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Lidar_x_DummyContState) + Name = "x%DummyContState" + case default + Name = "Unknown Field" + end select +end function + +subroutine Lidar_VarsPackContStateDeriv(Vars, x, ValAry) + type(Lidar_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call Lidar_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine Lidar_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(Lidar_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Lidar_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Lidar_VarsPackConstrState(Vars, z, ValAry) + type(Lidar_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call Lidar_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine Lidar_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(Lidar_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Lidar_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Lidar_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Lidar_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call Lidar_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine Lidar_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Lidar_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Lidar_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function Lidar_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Lidar_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine Lidar_VarsPackInput(Vars, u, ValAry) + type(Lidar_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call Lidar_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine Lidar_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(Lidar_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Lidar_u_PulseLidEl) + VarVals(1) = u%PulseLidEl ! Scalar + case (Lidar_u_PulseLidAz) + VarVals(1) = u%PulseLidAz ! Scalar + case (Lidar_u_HubDisplacementX) + VarVals(1) = u%HubDisplacementX ! Scalar + case (Lidar_u_HubDisplacementY) + VarVals(1) = u%HubDisplacementY ! Scalar + case (Lidar_u_HubDisplacementZ) + VarVals(1) = u%HubDisplacementZ ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Lidar_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Lidar_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call Lidar_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine Lidar_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Lidar_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Lidar_u_PulseLidEl) + u%PulseLidEl = VarVals(1) ! Scalar + case (Lidar_u_PulseLidAz) + u%PulseLidAz = VarVals(1) ! Scalar + case (Lidar_u_HubDisplacementX) + u%HubDisplacementX = VarVals(1) ! Scalar + case (Lidar_u_HubDisplacementY) + u%HubDisplacementY = VarVals(1) ! Scalar + case (Lidar_u_HubDisplacementZ) + u%HubDisplacementZ = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function Lidar_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Lidar_u_PulseLidEl) + Name = "u%PulseLidEl" + case (Lidar_u_PulseLidAz) + Name = "u%PulseLidAz" + case (Lidar_u_HubDisplacementX) + Name = "u%HubDisplacementX" + case (Lidar_u_HubDisplacementY) + Name = "u%HubDisplacementY" + case (Lidar_u_HubDisplacementZ) + Name = "u%HubDisplacementZ" + case default + Name = "Unknown Field" + end select +end function + +subroutine Lidar_VarsPackOutput(Vars, y, ValAry) + type(Lidar_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call Lidar_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine Lidar_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(Lidar_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Lidar_y_LidSpeed) + VarVals = y%LidSpeed(V%iLB:V%iUB) ! Rank 1 Array + case (Lidar_y_WtTrunc) + VarVals = y%WtTrunc(V%iLB:V%iUB) ! Rank 1 Array + case (Lidar_y_MsrPositionsX) + VarVals = y%MsrPositionsX(V%iLB:V%iUB) ! Rank 1 Array + case (Lidar_y_MsrPositionsY) + VarVals = y%MsrPositionsY(V%iLB:V%iUB) ! Rank 1 Array + case (Lidar_y_MsrPositionsZ) + VarVals = y%MsrPositionsZ(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Lidar_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Lidar_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call Lidar_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine Lidar_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Lidar_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Lidar_y_LidSpeed) + y%LidSpeed(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (Lidar_y_WtTrunc) + y%WtTrunc(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (Lidar_y_MsrPositionsX) + y%MsrPositionsX(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (Lidar_y_MsrPositionsY) + y%MsrPositionsY(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (Lidar_y_MsrPositionsZ) + y%MsrPositionsZ(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function Lidar_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Lidar_y_LidSpeed) + Name = "y%LidSpeed" + case (Lidar_y_WtTrunc) + Name = "y%WtTrunc" + case (Lidar_y_MsrPositionsX) + Name = "y%MsrPositionsX" + case (Lidar_y_MsrPositionsY) + Name = "y%MsrPositionsY" + case (Lidar_y_MsrPositionsZ) + Name = "y%MsrPositionsZ" + case default + Name = "Unknown Field" + end select +end function + END MODULE Lidar_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/lindyn/src/LinDyn_Types.f90 b/modules/lindyn/src/LinDyn_Types.f90 index b5d08e8d49..28cbce7930 100644 --- a/modules/lindyn/src/LinDyn_Types.f90 +++ b/modules/lindyn/src/LinDyn_Types.f90 @@ -123,7 +123,13 @@ MODULE LinDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< outputs to be written to a file [-] END TYPE LD_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: LD_x_q = 1 ! LD%q + integer(IntKi), public, parameter :: LD_z_Dummy = 2 ! LD%Dummy + integer(IntKi), public, parameter :: LD_u_Fext = 3 ! LD%Fext + integer(IntKi), public, parameter :: LD_y_xdd = 4 ! LD%xdd + integer(IntKi), public, parameter :: LD_y_WriteOutput = 5 ! LD%WriteOutput + +contains subroutine LD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(LD_InitInputType), intent(in) :: SrcInitInputData @@ -1555,5 +1561,283 @@ SUBROUTINE LD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function LD_InputMeshPointer(u, DL) result(Mesh) + type(LD_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +function LD_OutputMeshPointer(y, DL) result(Mesh) + type(LD_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +subroutine LD_VarsPackContState(Vars, x, ValAry) + type(LD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call LD_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine LD_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(LD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (LD_x_q) + VarVals = x%q(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine LD_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(LD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call LD_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine LD_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(LD_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (LD_x_q) + x%q(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function LD_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (LD_x_q) + Name = "x%q" + case default + Name = "Unknown Field" + end select +end function + +subroutine LD_VarsPackContStateDeriv(Vars, x, ValAry) + type(LD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call LD_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine LD_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(LD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (LD_x_q) + VarVals = x%q(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine LD_VarsPackConstrState(Vars, z, ValAry) + type(LD_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call LD_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine LD_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(LD_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (LD_z_Dummy) + VarVals(1) = z%Dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine LD_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(LD_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call LD_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine LD_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(LD_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (LD_z_Dummy) + z%Dummy = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function LD_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (LD_z_Dummy) + Name = "z%Dummy" + case default + Name = "Unknown Field" + end select +end function + +subroutine LD_VarsPackInput(Vars, u, ValAry) + type(LD_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call LD_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine LD_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(LD_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (LD_u_Fext) + VarVals = u%Fext(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine LD_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(LD_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call LD_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine LD_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(LD_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (LD_u_Fext) + u%Fext(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function LD_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (LD_u_Fext) + Name = "u%Fext" + case default + Name = "Unknown Field" + end select +end function + +subroutine LD_VarsPackOutput(Vars, y, ValAry) + type(LD_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call LD_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine LD_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(LD_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (LD_y_xdd) + VarVals = y%xdd(V%iLB:V%iUB) ! Rank 1 Array + case (LD_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine LD_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(LD_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call LD_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine LD_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(LD_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (LD_y_xdd) + y%xdd(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (LD_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function LD_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (LD_y_xdd) + Name = "y%xdd" + case (LD_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE LinDyn_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/map/CMakeLists.txt b/modules/map/CMakeLists.txt index 5f82519a62..8c34521b58 100644 --- a/modules/map/CMakeLists.txt +++ b/modules/map/CMakeLists.txt @@ -25,9 +25,7 @@ if (NOT WIN32) endif() if (GENERATE_TYPES) - generate_f90_types(src/MAP_Fortran_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/MAP_Fortran_Types.f90 -noextrap) generate_f90_types(src/MAP_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/MAP_Types.f90 -ccode) - generate_f90_types(src/MAP_Fortran_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/MAP_Fortran_Types.f90 -noextrap) endif() file(GLOB MAP_CLIB_SOURCES src/*.c src/*.cc src/*/*.c src/*/*.cc) @@ -36,7 +34,6 @@ file(GLOB MAP_C_HEADERS src/*.h src/*/*.h) add_library(mappplib STATIC src/map.f90 src/MAP_Types.f90 - src/MAP_Fortran_Types.f90 ${MAP_CLIB_SOURCES} ) target_sources( diff --git a/modules/map/src/MAP_Fortran_Registry.txt b/modules/map/src/MAP_Fortran_Registry.txt deleted file mode 100644 index b1ad941a80..0000000000 --- a/modules/map/src/MAP_Fortran_Registry.txt +++ /dev/null @@ -1,22 +0,0 @@ -################## Registry for MAP++ ############### -# column 1 -# column 2 ModuleName/ModName or ^ to use the value from the previous line (SD is nickname for ModuleName) -# column 3 Derived data type (without "ModName_" prefix) -# column 4 Derived data types's Field type -# column 5 Variable name -# column 6 Dimension of variable {:} for allocatable -# column 7 Variable's initial value (if set in the data type) -# column 8 I think this is a switch for mixed-language programming; it's mostly unused -# column 9 Description -# column 10 Units -# Keyword ModuleName/ModName Derived data type Field type Variable name variable dimension Initial value for mix language, not used Description Units - -include Registry_NWTC_Library.txt - -typedef MAP_Fortran/MAP_Fortran Lin_InitInputType LOGICAL linearize - .false. - "Flag that tells this module if the glue code wants to linearize. (fortran-only)" - -typedef ^ Lin_InitOutputType CHARACTER(200) LinNames_y {:} "" - "second line of output file contents: units (fortran-only)" - -typedef ^ ^ CHARACTER(200) LinNames_u {:} "" - "Names of the inputs used in linearization (fortran-only)" - -typedef ^ ^ LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) (fortran-only)" - -typedef ^ Lin_ParamType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian (fortran-only)" - -typedef ^ ^ R8Ki du - - - "determines size of the translational displacement perturbation for u (inputs) (fortran-only)" - -typedef ^ ^ Integer Jac_ny - - - "number of outputs in jacobian matrix (fortran-only)" - diff --git a/modules/map/src/MAP_Registry.txt b/modules/map/src/MAP_Registry.txt index 316376a55b..3efd562074 100644 --- a/modules/map/src/MAP_Registry.txt +++ b/modules/map/src/MAP_Registry.txt @@ -13,7 +13,6 @@ include Registry_NWTC_Library.txt -usefrom MAP_Fortran_Registry.txt ## ============================== Define input types here: ============================================================================================================================================ typedef MAP InitInputType R8Ki gravity - -999.9 - "gravity constant" "[m/s^2]" @@ -25,7 +24,7 @@ typedef ^ ^ CHARACTER(255) library_input_str typedef ^ ^ CHARACTER(255) node_input_str - "" - "node string information (from input file)" typedef ^ ^ CHARACTER(255) line_input_str - "" - "element library string information (from input file)" typedef ^ ^ CHARACTER(255) option_input_str - "" - "solver options library string information (from input file)" -typedef ^ ^ Lin_InitInputType LinInitInp - - - " " - +typedef ^ ^ logical Linearize - "" - "Flag to perform linearization" ## ============================== Define Initialization outputs here: ================================================================================================================================ typedef ^ InitOutputType CHARACTER(99) progName - "" - "program name" typedef ^ ^ CHARACTER(99) version - "" - "version numnber" @@ -33,7 +32,7 @@ typedef ^ ^ CHARACTER(24) compilingData typedef ^ ^ CHARACTER(15) writeOutputHdr {:} "" - "first line output file contents: output variable names" typedef ^ ^ CHARACTER(15) writeOutputUnt {:} "" - "second line of output file contents: units" typedef ^ ^ ProgDesc Ver - "" - "this module's name, version, and date" -typedef ^ ^ Lin_InitOutputType LinInitOut - - - "Init Output linearization data (fortran-only)" - +typedef ^ ^ ModVarsType Vars - - - "Module Variables" - ## ============================== Define Continuous states here: ===================================================================================================================================== typedef ^ ContinuousStateType R8Ki dummy - - - "Remove this variable if you have continuous states" - @@ -83,7 +82,6 @@ typedef ^ ^ R8Ki dt typedef ^ ^ CHARACTER(255) InputLines {500} - - "input file line for restart" typedef ^ ^ CHARACTER(1) InputLineType {500} - - "input file line type for restart" typedef ^ ^ INTEGER numOuts - 0 - "Number of write outputs" - -typedef ^ ^ Lin_ParamType LinParams - - - "Parameter linearization data (fortran-only)" - # ============================== Inputs ============================================================================================================================================ typedef ^ InputType R8Ki x {:} - - "fairlead x displacement" "[m]" @@ -100,4 +98,7 @@ typedef ^ ^ ReKi WriteOutput typedef ^ ^ R8Ki wrtOutput {:} - - "outpur vector" "" typedef ^ ^ MeshType ptFairleadLoad - - - "point mesh for forces in X,Y,Z" "[N]" - +## ============================== MiscVar ============================================================================================================================================ +typedef ^ MiscVarType ModJacType Jac - - - "Values corresponding to module variables" +typedef ^ ^ MAP_InputType u_perturb - - - "Temporary variables for Jacobian calculations" +typedef ^ ^ MAP_ConstraintStateType z_lin - - - "Temporary variables for Jacobian calculations" diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index c83fae8198..f73948cdfe 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -31,7 +31,6 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE MAP_Types !--------------------------------------------------------------------------------------------------------------------------------- -USE MAP_Fortran_Types USE NWTC_Library IMPLICIT NONE ! ========= MAP_InitInputType_C ======= @@ -46,6 +45,7 @@ MODULE MAP_Types CHARACTER(KIND=C_CHAR), DIMENSION(255) :: node_input_str CHARACTER(KIND=C_CHAR), DIMENSION(255) :: line_input_str CHARACTER(KIND=C_CHAR), DIMENSION(255) :: option_input_str + LOGICAL(KIND=C_BOOL) :: Linearize END TYPE MAP_InitInputType_C TYPE, PUBLIC :: MAP_InitInputType TYPE( MAP_InitInputType_C ) :: C_obj @@ -58,7 +58,7 @@ MODULE MAP_Types CHARACTER(255) :: node_input_str !< node string information (from input file) [-] CHARACTER(255) :: line_input_str !< element library string information (from input file) [-] CHARACTER(255) :: option_input_str !< solver options library string information (from input file) [-] - TYPE(Lin_InitInputType) :: LinInitInp !< [-] + LOGICAL :: Linearize = .false. !< Flag to perform linearization [-] END TYPE MAP_InitInputType ! ======================= ! ========= MAP_InitOutputType_C ======= @@ -80,7 +80,7 @@ MODULE MAP_Types CHARACTER(15) , DIMENSION(:), ALLOCATABLE :: writeOutputHdr !< first line output file contents: output variable names [-] CHARACTER(15) , DIMENSION(:), ALLOCATABLE :: writeOutputUnt !< second line of output file contents: units [-] TYPE(ProgDesc) :: Ver !< this module's name, version, and date [-] - TYPE(Lin_InitOutputType) :: LinInitOut !< Init Output linearization data (fortran-only) [-] + TYPE(ModVarsType) :: Vars !< Module Variables [-] END TYPE MAP_InitOutputType ! ======================= ! ========= MAP_ContinuousStateType_C ======= @@ -200,7 +200,6 @@ MODULE MAP_Types CHARACTER(255) , DIMENSION(1:500) :: InputLines !< input file line for restart [-] CHARACTER(1) , DIMENSION(1:500) :: InputLineType !< input file line type for restart [-] INTEGER(IntKi) :: numOuts = 0 !< Number of write outputs [-] - TYPE(Lin_ParamType) :: LinParams !< Parameter linearization data (fortran-only) [-] END TYPE MAP_ParameterType ! ======================= ! ========= MAP_InputType_C ======= @@ -245,7 +244,35 @@ MODULE MAP_Types TYPE(MeshType) :: ptFairleadLoad !< point mesh for forces in X,Y,Z [[N]] END TYPE MAP_OutputType ! ======================= -CONTAINS +! ========= MAP_MiscVarType_C ======= + TYPE, BIND(C) :: MAP_MiscVarType_C + TYPE(C_PTR) :: object = C_NULL_PTR + END TYPE MAP_MiscVarType_C + TYPE, PUBLIC :: MAP_MiscVarType + TYPE( MAP_MiscVarType_C ) :: C_obj + TYPE(ModJacType) :: Jac !< Values corresponding to module variables [-] + TYPE(MAP_InputType) :: u_perturb !< Temporary variables for Jacobian calculations [-] + TYPE(MAP_ConstraintStateType) :: z_lin !< Temporary variables for Jacobian calculations [-] + END TYPE MAP_MiscVarType +! ======================= + integer(IntKi), public, parameter :: MAP_x_dummy = 1 ! MAP%dummy + integer(IntKi), public, parameter :: MAP_z_H = 2 ! MAP%H + integer(IntKi), public, parameter :: MAP_z_V = 3 ! MAP%V + integer(IntKi), public, parameter :: MAP_z_x = 4 ! MAP%x + integer(IntKi), public, parameter :: MAP_z_y = 5 ! MAP%y + integer(IntKi), public, parameter :: MAP_z_z = 6 ! MAP%z + integer(IntKi), public, parameter :: MAP_u_x = 7 ! MAP%x + integer(IntKi), public, parameter :: MAP_u_y = 8 ! MAP%y + integer(IntKi), public, parameter :: MAP_u_z = 9 ! MAP%z + integer(IntKi), public, parameter :: MAP_u_PtFairDisplacement = 10 ! MAP%PtFairDisplacement + integer(IntKi), public, parameter :: MAP_y_Fx = 11 ! MAP%Fx + integer(IntKi), public, parameter :: MAP_y_Fy = 12 ! MAP%Fy + integer(IntKi), public, parameter :: MAP_y_Fz = 13 ! MAP%Fz + integer(IntKi), public, parameter :: MAP_y_WriteOutput = 14 ! MAP%WriteOutput + integer(IntKi), public, parameter :: MAP_y_wrtOutput = 15 ! MAP%wrtOutput + integer(IntKi), public, parameter :: MAP_y_ptFairleadLoad = 16 ! MAP%ptFairleadLoad + +contains subroutine MAP_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(MAP_InitInputType), intent(in) :: SrcInitInputData @@ -253,8 +280,6 @@ subroutine MAP_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MAP_CopyInitInput' ErrStat = ErrID_None ErrMsg = '' @@ -276,22 +301,17 @@ subroutine MAP_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%C_obj%line_input_str = SrcInitInputData%C_obj%line_input_str DstInitInputData%option_input_str = SrcInitInputData%option_input_str DstInitInputData%C_obj%option_input_str = SrcInitInputData%C_obj%option_input_str - call MAP_Fortran_CopyLin_InitInputType(SrcInitInputData%LinInitInp, DstInitInputData%LinInitInp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%C_obj%Linearize = SrcInitInputData%C_obj%Linearize end subroutine subroutine MAP_DestroyInitInput(InitInputData, ErrStat, ErrMsg) type(MAP_InitInputType), intent(inout) :: InitInputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MAP_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' - call MAP_Fortran_DestroyLin_InitInputType(InitInputData%LinInitInp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine MAP_PackInitInput(RF, Indata) @@ -312,7 +332,7 @@ subroutine MAP_PackInitInput(RF, Indata) call RegPack(RF, InData%node_input_str) call RegPack(RF, InData%line_input_str) call RegPack(RF, InData%option_input_str) - call MAP_Fortran_PackLin_InitInputType(RF, InData%LinInitInp) + call RegPack(RF, InData%Linearize) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -339,7 +359,8 @@ subroutine MAP_UnPackInitInput(RF, OutData) OutData%C_obj%line_input_str = transfer(OutData%line_input_str, OutData%C_obj%line_input_str ) call RegUnpack(RF, OutData%option_input_str); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%option_input_str = transfer(OutData%option_input_str, OutData%C_obj%option_input_str ) - call MAP_Fortran_UnpackLin_InitInputType(RF, OutData%LinInitInp) ! LinInitInp + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%Linearize = OutData%Linearize end subroutine SUBROUTINE MAP_C2Fary_CopyInitInput(InitInputData, ErrStat, ErrMsg, SkipPointers) @@ -366,6 +387,7 @@ SUBROUTINE MAP_C2Fary_CopyInitInput(InitInputData, ErrStat, ErrMsg, SkipPointers InitInputData%node_input_str = TRANSFER(InitInputData%C_obj%node_input_str, InitInputData%node_input_str ) InitInputData%line_input_str = TRANSFER(InitInputData%C_obj%line_input_str, InitInputData%line_input_str ) InitInputData%option_input_str = TRANSFER(InitInputData%C_obj%option_input_str, InitInputData%option_input_str ) + InitInputData%Linearize = InitInputData%C_obj%Linearize END SUBROUTINE SUBROUTINE MAP_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) @@ -392,6 +414,7 @@ SUBROUTINE MAP_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers 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) + InitInputData%C_obj%Linearize = InitInputData%Linearize END SUBROUTINE subroutine MAP_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -439,7 +462,7 @@ subroutine MAP_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call MAP_Fortran_CopyLin_InitOutputType(SrcInitOutputData%LinInitOut, DstInitOutputData%LinInitOut, CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end subroutine @@ -461,7 +484,7 @@ subroutine MAP_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MAP_Fortran_DestroyLin_InitOutputType(InitOutputData%LinInitOut, ErrStat2, ErrMsg2) + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -480,7 +503,7 @@ subroutine MAP_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%writeOutputHdr) call RegPackAlloc(RF, InData%writeOutputUnt) call NWTC_Library_PackProgDesc(RF, InData%Ver) - call MAP_Fortran_PackLin_InitOutputType(RF, InData%LinInitOut) + call NWTC_Library_PackModVarsType(RF, InData%Vars) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -501,7 +524,7 @@ subroutine MAP_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%writeOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%writeOutputUnt); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver - call MAP_Fortran_UnpackLin_InitOutputType(RF, OutData%LinInitOut) ! LinInitOut + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end subroutine SUBROUTINE MAP_C2Fary_CopyInitOutput(InitOutputData, ErrStat, ErrMsg, SkipPointers) @@ -1880,8 +1903,6 @@ subroutine MAP_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MAP_CopyParam' ErrStat = ErrID_None ErrMsg = '' @@ -1897,22 +1918,15 @@ subroutine MAP_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%InputLineType = SrcParamData%InputLineType DstParamData%numOuts = SrcParamData%numOuts DstParamData%C_obj%numOuts = SrcParamData%C_obj%numOuts - call MAP_Fortran_CopyLin_ParamType(SrcParamData%LinParams, DstParamData%LinParams, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end subroutine subroutine MAP_DestroyParam(ParamData, ErrStat, ErrMsg) type(MAP_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MAP_DestroyParam' ErrStat = ErrID_None ErrMsg = '' - call MAP_Fortran_DestroyLin_ParamType(ParamData%LinParams, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine MAP_PackParam(RF, Indata) @@ -1931,7 +1945,6 @@ subroutine MAP_PackParam(RF, Indata) call RegPack(RF, InData%InputLines) call RegPack(RF, InData%InputLineType) call RegPack(RF, InData%numOuts) - call MAP_Fortran_PackLin_ParamType(RF, InData%LinParams) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1952,7 +1965,6 @@ subroutine MAP_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%InputLineType); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%numOuts); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%numOuts = OutData%numOuts - call MAP_Fortran_UnpackLin_ParamType(RF, OutData%LinParams) ! LinParams end subroutine SUBROUTINE MAP_C2Fary_CopyParam(ParamData, ErrStat, ErrMsg, SkipPointers) @@ -2534,6 +2546,104 @@ SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) END IF END SUBROUTINE +subroutine MAP_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(MAP_MiscVarType), intent(inout) :: SrcMiscData + type(MAP_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyConstrState(SrcMiscData%z_lin, DstMiscData%z_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine MAP_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(MAP_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyConstrState(MiscData%z_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine MAP_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MAP_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call NWTC_Library_PackModJacType(RF, InData%Jac) + call MAP_PackInput(RF, InData%u_perturb) + call MAP_PackConstrState(RF, InData%z_lin) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MAP_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MAP_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackMisc' + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call MAP_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call MAP_UnpackConstrState(RF, OutData%z_lin) ! z_lin +end subroutine + +SUBROUTINE MAP_C2Fary_CopyMisc(MiscData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF +END SUBROUTINE + +SUBROUTINE MAP_F2C_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF +END SUBROUTINE + subroutine MAP_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time @@ -2901,5 +3011,353 @@ SUBROUTINE MAP_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er CALL MeshExtrapInterp2(y1%ptFairleadLoad, y2%ptFairleadLoad, y3%ptFairleadLoad, tin, y_out%ptFairleadLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE + +function MAP_InputMeshPointer(u, DL) result(Mesh) + type(MAP_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (MAP_u_PtFairDisplacement) + Mesh => u%PtFairDisplacement + end select +end function + +function MAP_OutputMeshPointer(y, DL) result(Mesh) + type(MAP_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (MAP_y_ptFairleadLoad) + Mesh => y%ptFairleadLoad + end select +end function + +subroutine MAP_VarsPackContState(Vars, x, ValAry) + type(MAP_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call MAP_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine MAP_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(MAP_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MAP_x_dummy) + VarVals(1) = x%dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine MAP_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(MAP_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call MAP_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine MAP_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(MAP_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MAP_x_dummy) + x%dummy = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function MAP_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (MAP_x_dummy) + Name = "x%dummy" + case default + Name = "Unknown Field" + end select +end function + +subroutine MAP_VarsPackContStateDeriv(Vars, x, ValAry) + type(MAP_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call MAP_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine MAP_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(MAP_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MAP_x_dummy) + VarVals(1) = x%dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine MAP_VarsPackConstrState(Vars, z, ValAry) + type(MAP_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call MAP_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine MAP_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(MAP_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MAP_z_H) + VarVals = z%H(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_z_V) + VarVals = z%V(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_z_x) + VarVals = z%x(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_z_y) + VarVals = z%y(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_z_z) + VarVals = z%z(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine MAP_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(MAP_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call MAP_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine MAP_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(MAP_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MAP_z_H) + z%H(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_z_V) + z%V(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_z_x) + z%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_z_y) + z%y(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_z_z) + z%z(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function MAP_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (MAP_z_H) + Name = "z%H" + case (MAP_z_V) + Name = "z%V" + case (MAP_z_x) + Name = "z%x" + case (MAP_z_y) + Name = "z%y" + case (MAP_z_z) + Name = "z%z" + case default + Name = "Unknown Field" + end select +end function + +subroutine MAP_VarsPackInput(Vars, u, ValAry) + type(MAP_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call MAP_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine MAP_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(MAP_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MAP_u_x) + VarVals = u%x(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_u_y) + VarVals = u%y(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_u_z) + VarVals = u%z(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_u_PtFairDisplacement) + call MV_PackMesh(V, u%PtFairDisplacement, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine MAP_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(MAP_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call MAP_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine MAP_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(MAP_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MAP_u_x) + u%x(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_u_y) + u%y(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_u_z) + u%z(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_u_PtFairDisplacement) + call MV_UnpackMesh(V, ValAry, u%PtFairDisplacement) ! Mesh + end select + end associate +end subroutine + +function MAP_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (MAP_u_x) + Name = "u%x" + case (MAP_u_y) + Name = "u%y" + case (MAP_u_z) + Name = "u%z" + case (MAP_u_PtFairDisplacement) + Name = "u%PtFairDisplacement" + case default + Name = "Unknown Field" + end select +end function + +subroutine MAP_VarsPackOutput(Vars, y, ValAry) + type(MAP_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call MAP_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine MAP_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(MAP_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MAP_y_Fx) + VarVals = y%Fx(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_y_Fy) + VarVals = y%Fy(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_y_Fz) + VarVals = y%Fz(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_y_wrtOutput) + VarVals = y%wrtOutput(V%iLB:V%iUB) ! Rank 1 Array + case (MAP_y_ptFairleadLoad) + call MV_PackMesh(V, y%ptFairleadLoad, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine MAP_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(MAP_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call MAP_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine MAP_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(MAP_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MAP_y_Fx) + y%Fx(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_y_Fy) + y%Fy(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_y_Fz) + y%Fz(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_y_wrtOutput) + y%wrtOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MAP_y_ptFairleadLoad) + call MV_UnpackMesh(V, ValAry, y%ptFairleadLoad) ! Mesh + end select + end associate +end subroutine + +function MAP_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (MAP_y_Fx) + Name = "y%Fx" + case (MAP_y_Fy) + Name = "y%Fy" + case (MAP_y_Fz) + Name = "y%Fz" + case (MAP_y_WriteOutput) + Name = "y%WriteOutput" + case (MAP_y_wrtOutput) + Name = "y%wrtOutput" + case (MAP_y_ptFairleadLoad) + Name = "y%ptFairleadLoad" + case default + Name = "Unknown Field" + end select +end function + END MODULE MAP_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/map/src/MAP_Types.h b/modules/map/src/MAP_Types.h index 9040c07793..1297250660 100644 --- a/modules/map/src/MAP_Types.h +++ b/modules/map/src/MAP_Types.h @@ -29,6 +29,7 @@ typedef struct MAP_InitInputType { char node_input_str[255]; char line_input_str[255]; char option_input_str[255]; + bool Linearize; } MAP_InitInputType_t; typedef struct MAP_InitOutputType { @@ -104,6 +105,10 @@ typedef struct MAP_OutputType { double *wrtOutput; int wrtOutput_Len; } MAP_OutputType_t; +typedef struct MAP_MiscVarType { + void *object; +} MAP_MiscVarType_t; + typedef struct MAP_UserData { MAP_InitInputType_t MAP_InitInput; MAP_InitOutputType_t MAP_InitOutput; @@ -114,6 +119,7 @@ typedef struct MAP_UserData { MAP_ParameterType_t MAP_Param; MAP_InputType_t MAP_Input; MAP_OutputType_t MAP_Output; + MAP_MiscVarType_t MAP_Misc; } MAP_t; #endif // _MAP_TYPES_H diff --git a/modules/map/src/map.f90 b/modules/map/src/map.f90 index d116bdd5cd..d2c2d7a4af 100644 --- a/modules/map/src/map.f90 +++ b/modules/map/src/map.f90 @@ -33,7 +33,6 @@ MODULE MAP PUBLIC :: MAP_UpdateStates PUBLIC :: MAP_CalcOutput PUBLIC :: MAP_JacobianPInput - PUBLIC :: MAP_GetOP PUBLIC :: MAP_End PUBLIC :: MAP_Restart @@ -497,7 +496,7 @@ SUBROUTINE MAP_Restart( u, p, x, xd, z, other, y, ErrStat, ErrMsg ) END SUBROUTINE MAP_Restart !========== MAP_Init ====== <----------------------------------------------------------------------+ - SUBROUTINE MAP_Init( InitInp, u, p, x, xd, z, other, y, Interval, InitOut, ErrStat, ErrMsg ) + SUBROUTINE MAP_Init( InitInp, u, p, x, xd, z, other, y, m, Interval, InitOut, ErrStat, ErrMsg ) IMPLICIT NONE TYPE( MAP_InitInputType ), INTENT(INOUT) :: InitInp ! INTENT(IN ) : Input data for initialization routine TYPE( MAP_InputType ), INTENT( OUT) :: u ! INTENT( OUT) : An initial guess for the input; input mesh must be defined @@ -507,6 +506,7 @@ SUBROUTINE MAP_Init( InitInp, u, p, x, xd, z, other, y, Interval, InitOut, ErrSt TYPE( MAP_ConstraintStateType ), INTENT( OUT) :: z ! INTENT( OUT) : Initial guess of the constraint states TYPE( MAP_OtherStateType ), INTENT( OUT) :: other ! INTENT( OUT) : Initial other/optimization states TYPE( MAP_OutputType ), INTENT( OUT) :: y ! INTENT( OUT) : Initial system outputs (outputs are not calculated; only the output mesh is initialized) + TYPE( MAP_MiscVarType ), INTENT( OUT) :: m ! INTENT( OUT) : Initial system mischellaneous vars REAL(DbKi), INTENT(INOUT) :: Interval ! Coupling interval in seconds: the rate that Output is the actual coupling interval TYPE( MAP_InitOutputType ), INTENT(INOUT) :: InitOut ! Output for initialization routine INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation @@ -686,19 +686,98 @@ SUBROUTINE MAP_Init( InitInp, u, p, x, xd, z, other, y, Interval, InitOut, ErrSt allocate( y%WriteOutput(p%numOuts), STAT=N) if (N/=0) call SetErrStat(ErrID_Fatal, 'Failed to allocate y%WriteOutput',ErrStat, ErrMsg, RoutineName) end if + + !............................................................................................ + ! Module Variables + !............................................................................................ + call MAP_InitVars(InitOut%Vars, InitInp, u, p, x, z, y, m, InitOut, InitInp%Linearize, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !............................................................................................ ! Initialize Jacobian information: !............................................................................................ - if (InitInp%LinInitInp%Linearize) then - call map_Init_Jacobian( p, u, y, InitOut, ErrStat2, ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if + ! if (InitInp%LinInitInp%Linearize) then + ! call map_Init_Jacobian( p, u, y, InitOut, ErrStat2, ErrMsg2) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! end if END SUBROUTINE MAP_Init ! -------+ !========================================================================================================== + !---------------------------------------------------------------------------------------------------------------------------------- + !> This routine initializes module variables for use by the solver and linearization. + subroutine MAP_InitVars(Vars, InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(ModVarsType), intent(out) :: Vars !< Module variables + type(MAP_InitInputType), intent(in) :: InitInp !< Initialization input + type(MAP_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(MAP_ParameterType), intent(inout) :: p !< Parameters + type(MAP_ContinuousStateType), intent(inout) :: x !< Continuous state + type(MAP_ConstraintStateType), intent(inout) :: z !< Constraint state + type(MAP_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(MAP_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(MAP_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'MAP_InitVars' + integer(IntKi) :: ErrStat2 ! Temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + integer(IntKi) :: i + real(R8Ki) :: Perturb + + ErrStat = ErrID_None + ErrMsg = "" + + !------------------------------------------------------------------------- + ! Continuous State Variables + !------------------------------------------------------------------------- + + !------------------------------------------------------------------------- + ! Input variables + !------------------------------------------------------------------------- + + call MV_AddMeshVar(Vars%u, "PtFairDisplacement", [FieldTransDisp], & + DatLoc(MAP_u_PtFairDisplacement), & + Mesh=u%PtFairDisplacement, & + Perturbs=[0.2_R8Ki*D2R * max(p%depth,1.0_R8Ki)]) + + !------------------------------------------------------------------------- + ! Output variables + !------------------------------------------------------------------------- + + call MV_AddMeshVar(Vars%y, "FairleadLoads", [FieldForce], & + DatLoc(MAP_y_PtFairleadLoad), & + Mesh=y%ptFairleadLoad) + + ! Write outputs + call MV_AddVar(Vars%y, "WriteOutput", FieldScalar, & + DatLoc(MAP_y_WriteOutput), & + Flags=VF_WriteOut, & + Num=p%numOuts,& + LinNames=[(WriteOutputLinName(i), i = 1, p%numOuts)]) + + !------------------------------------------------------------------------- + ! Initialize Variables and Jacobian data + !------------------------------------------------------------------------- + + CALL MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + call MAP_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call MAP_CopyConstrState(z, m%z_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + + contains + character(LinChanLen) function WriteOutputLinName(idx) + integer(IntKi), intent(in) :: idx + WriteOutputLinName = trim(InitOut%WriteOutputHdr(idx))//', '//trim(InitOut%WriteOutputUnt(idx)) + end function + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed + end subroutine + !========== MAP_UpdateStates ====== <-------------------------------------------------------------+ SUBROUTINE MAP_UpdateStates( t, n, u, utimes, p, x, xd, z, O, ErrStat, ErrMsg) REAL(DbKi) , INTENT(IN ) :: t @@ -1078,186 +1157,10 @@ SUBROUTINE map_set_input_file_contents(InitInp, p) END DO END SUBROUTINE map_set_input_file_contents -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine map::map_init_jacobian is consistant with this routine! -SUBROUTINE map_Perturb_u( p, n, perturb_sign, u, du ) - - TYPE(map_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(map_InputType) , INTENT(INOUT) :: u !< perturbed map inputs - REAL( R8Ki ) , INTENT( OUT) :: du !< amount that specific input was perturbed - - - ! local variables - integer :: fieldIndx - integer :: node - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - fieldIndx = p%LinParams%Jac_u_indx(n,2) - node = p%LinParams%Jac_u_indx(n,3) - du = p%LinParams%du - u%PtFairDisplacement%TranslationDisp (fieldIndx,node) = u%PtFairDisplacement%TranslationDisp (fieldIndx,node) + du * perturb_sign - -END SUBROUTINE map_Perturb_u -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine map::map_init_jacobian is consistant with this routine! -SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) - - TYPE(map_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(map_OutputType) , INTENT(IN ) :: y_p !< map outputs at \f$ u + \Delta u \f$ or \f$ x + \Delta x \f$ (p=plus) - TYPE(map_OutputType) , INTENT(IN ) :: y_m !< map outputs at \f$ u - \Delta u \f$ or \f$ x - \Delta x \f$ (m=minus) - REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta = \Delta u \f$ or \f$ delta = \Delta x \f$ - REAL(R8Ki) , INTENT(INOUT) :: dY(:) !< column of dYdu or dYdx: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial x_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ - - ! local variables: - - integer(IntKi) :: indx_first ! index indicating next value of dY to be filled - logical :: Mask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing - integer(IntKi) :: k - - indx_first = 1 - if ( y_p%ptFairleadLoad%Committed ) then - call PackLoadMesh_dY(y_p%ptFairleadLoad, y_m%ptFairleadLoad, dY, indx_first) - end if - - do k=1,p%numOuts - dY(k+indx_first-1) = y_p%WriteOutput(k) - y_m%WriteOutput(k) - end do - - - - dY = dY / (2.0_R8Ki*delta) - -END SUBROUTINE Compute_dY -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the array that maps rows/columns of the Jacobian to specific mesh fields. -!! Do not change the order of this packing without changing corresponding linearization routines ! -SUBROUTINE MAP_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) - - TYPE(map_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(map_InputType) , INTENT(IN ) :: u !< inputs - TYPE(map_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(map_InitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Init_Jacobian' - - ! local variables: - INTEGER(IntKi) :: i, j, k, index, index_next, index_last, nu, i_meshField, m, meshFieldCount - REAL(R8Ki) :: perturb_t, perturb - REAL(R8Ki) :: ScaleLength - LOGICAL :: FieldMask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing - - ErrStat = ErrID_None - ErrMsg = "" - - !...................................... - ! init linearization outputs: - !...................................... - - ! determine how many outputs there are in the Jacobians - p%LinParams%Jac_ny = 0 - if ( y%ptFairleadLoad%Committed ) then - p%LinParams%Jac_ny = y%ptFairleadLoad%NNodes * 3 ! 3 Forces, no Moments, at each node on the fairlead loads mesh - end if - - p%LinParams%Jac_ny = p%LinParams%Jac_ny + p%numOuts ! WriteOutput values - - !................. - ! set linearization output names: - !................. - call AllocAry(InitOut%LinInitOut%LinNames_y, p%LinParams%Jac_ny, 'LinNames_y', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - index_next = 1 - if ( y%ptFairleadLoad%Committed ) then - index_last = index_next - call PackLoadMesh_Names(y%ptFairleadLoad, 'FairleadLoads', InitOut%LinInitOut%LinNames_y, index_next) - end if - - index_last = index_next - do i=1,p%numOuts - InitOut%LinInitOut%LinNames_y(i+index_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) - end do - - - !...................................... - ! init linearization inputs: - !...................................... - - - ! determine how many inputs there are in the Jacobians - nu = 0; - if ( u%PtFairDisplacement%Committed ) then - nu = nu + u%PtFairDisplacement%NNodes * 3 ! 3 TranslationDisp at each node - end if - ! note: all other inputs are ignored - - !.................... - ! fill matrix to store index to help us figure out what the ith value of the u vector really means - ! (see hydrodyn::map_perturb_u ... these MUST match ) - ! column 1 indicates module's mesh and field - ! column 2 indicates the first index of the acceleration/load field - ! column 3 is the node - !.................... - - !............... - ! MAP input mappings stored in p%Jac_u_indx: - !............... - call AllocAry(p%LinParams%Jac_u_indx, nu, 3, 'p%LinParams%Jac_u_indx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - index = 1 - meshFieldCount = 0 - if ( u%PtFairDisplacement%Committed ) then - !Module/Mesh/Field: u%PtFairDisplacement%TranslationDisp = 1; - i_meshField = 1 - do i=1,u%PtFairDisplacement%NNodes - do j=1,3 - p%LinParams%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%PtFairDisplacement%{TranslationDisp} = m - p%LinParams%Jac_u_indx(index,2) = j !index: j - p%LinParams%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - meshFieldCount = meshFieldCount + 1 - end if - !................ - ! input perturbations, du: - !................ - - p%LinParams%du = 0.2_R8Ki*D2R * max(p%depth,1.0_R8Ki) ! translation input scaling ! u%PtFairDisplacement%TranslationDisp - - !................ - ! names of the columns, InitOut%LinNames_u: - !................ - call AllocAry(InitOut%LinInitOut%LinNames_u, nu, 'LinNames_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call AllocAry(InitOut%LinInitOut%IsLoad_u, nu, 'IsLoad_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - InitOut%LinInitOut%IsLoad_u(:) = .false. ! MAP's inputs are NOT loads - - index = 1 - if ( u%PtFairDisplacement%Committed ) then - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - call PackMotionMesh_Names(u%PtFairDisplacement, 'PtFairDisplacement', InitOut%LinInitOut%LinNames_u, index, FieldMask=FieldMask) - end if - -END SUBROUTINE MAP_Init_Jacobian - -SUBROUTINE MAP_JacobianPInput( t, u, p, x, xd, z, OtherState, y, ErrStat, ErrMsg, dYdu ) +SUBROUTINE MAP_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(map_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(map_ParameterType), INTENT(INOUT) :: p !< Parameters @@ -1269,236 +1172,144 @@ SUBROUTINE MAP_JacobianPInput( t, u, p, x, xd, z, OtherState, y, ErrStat, ErrMsg !! 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(map_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] - - - ! local variables - INTEGER(KIND=C_INT) :: status_from_MAP - CHARACTER(KIND=C_CHAR), DIMENSION(1024) :: message_from_MAP - REAL(KIND=C_FLOAT) :: time - INTEGER(KIND=C_INT) :: interval - - TYPE(map_OutputType) :: y_p - TYPE(map_OutputType) :: y_m - TYPE(map_ConstraintStateType) :: z_perturb - TYPE(map_InputType) :: u_perturb - REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, j, NN, offsetI, offsetJ + 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] + CHARACTER(*), PARAMETER :: RoutineName = 'map_JacobianPInput' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'map_JacobianPInput' - + INTEGER(KIND=C_INT) :: status_from_MAP + CHARACTER(KIND=C_CHAR), DIMENSION(1024) :: message_from_MAP + REAL(KIND=C_FLOAT) :: time + INTEGER(KIND=C_INT) :: interval + INTEGER(IntKi) :: i, j, NN, offsetI, offsetJ, col - ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' + time = t interval = t / p%dt - if ( present( dYdu ) ) then + ! Make a copy of the inputs to perturb + call MAP_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call MAP_VarsPackInput(Vars, u, m%Jac%u) - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + if (present(dYdu)) then ! allocate dYdu if necessary if (.not. allocated(dYdu)) then - call AllocAry(dYdu, p%LinParams%Jac_ny, size(p%LinParams%Jac_u_indx,1), 'dYdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dYdu, Vars%Ny, Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if - - - do i=1,size(p%LinParams%Jac_u_indx,1) - - ! get u_op + delta u - call map_CopyInput( u, u_perturb, MESH_NEWCOPY, 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 map_Perturb_u( p, i, 1, u_perturb, delta ) - call MAP_CopyConstrState( z, z_perturb, MESH_NEWCOPY, 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 - - DO j = 1,u_perturb%PtFairDisplacement%NNodes - u_perturb%X(j) = u_perturb%PtFairDisplacement%Position(1,j) + u_perturb%PtFairDisplacement%TranslationDisp(1,j) - u_perturb%Y(j) = u_perturb%PtFairDisplacement%Position(2,j) + u_perturb%PtFairDisplacement%TranslationDisp(2,j) - u_perturb%Z(j) = u_perturb%PtFairDisplacement%Position(3,j) + u_perturb%PtFairDisplacement%TranslationDisp(3,j) - END DO - - ! compute constraint state for u_op + delta u - call MSQS_UpdateStates( time , & - interval , & - u_perturb%C_obj , & - p%C_obj , & - x%C_obj , & - xd%C_obj , & - z_perturb%C_obj , & - OtherState%C_obj , & - status_from_MAP , & - message_from_MAP ) + ! Loop through input variables + do i = 1, size(Vars%u) - call MAP_ERROR_CHECKER(message_from_MAP,status_from_MAP,ErrMsg2,ErrStat2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg, RoutineName) + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%u(i)%Num - + ! Calculate positive perturbation + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call MAP_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call MAP_CopyConstrState(z, m%z_lin, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + + ! Calculate absolute position of each node + m%u_perturb%X = m%u_perturb%PtFairDisplacement%Position(1,:) + m%u_perturb%PtFairDisplacement%TranslationDisp(1,:) + m%u_perturb%Y = m%u_perturb%PtFairDisplacement%Position(2,:) + m%u_perturb%PtFairDisplacement%TranslationDisp(2,:) + m%u_perturb%Z = m%u_perturb%PtFairDisplacement%Position(3,:) + m%u_perturb%PtFairDisplacement%TranslationDisp(3,:) + ! Compute constraint state for u_op + delta u + call MSQS_UpdateStates(time, & + interval, & + m%u_perturb%C_obj, & + p%C_obj, & + x%C_obj, & + xd%C_obj, & + m%z_lin%C_obj, & + OtherState%C_obj, & + status_from_MAP, & + message_from_MAP ) + + call MAP_ERROR_CHECKER(message_from_MAP, status_from_MAP, ErrMsg2, ErrStat2); if (Failed()) return + ! compute y at u_op + delta u - call map_CalcOutput( t, u_perturb, p, x, xd, z_perturb, OtherState, y, 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 + ! MAP++ (in the c-code) requires that the output data structure be y, which was used when MAP++ was initialized. + call map_CalcOutput(t, m%u_perturb, p, x, xd, m%z_lin, OtherState, y, ErrStat2, ErrMsg2); if (Failed()) return + call MAP_VarsPackOutput(Vars, y, m%Jac%y_pos) - ! We need to do this copy inside the loop because MAP++ (in the c-code) requires that the output data structure be y, which was used when MAP++ was initialized. - call map_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! Calculate negative perturbation + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call MAP_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call MAP_CopyConstrState(z, m%z_lin, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - ! get u_op - delta u - call map_CopyInput( u, u_perturb, MESH_NEWCOPY, 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 - - ! Minus perturbation - call map_Perturb_u( p, i, -1, u_perturb, delta ) - - call MAP_CopyConstrState( z, z_perturb, MESH_NEWCOPY, 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 - - - DO j = 1,u_perturb%PtFairDisplacement%NNodes - u_perturb%X(j) = u_perturb%PtFairDisplacement%Position(1,j) + u_perturb%PtFairDisplacement%TranslationDisp(1,j) - u_perturb%Y(j) = u_perturb%PtFairDisplacement%Position(2,j) + u_perturb%PtFairDisplacement%TranslationDisp(2,j) - u_perturb%Z(j) = u_perturb%PtFairDisplacement%Position(3,j) + u_perturb%PtFairDisplacement%TranslationDisp(3,j) - END DO + ! Calculate absolute position of each node + m%u_perturb%X = m%u_perturb%PtFairDisplacement%Position(1,:) + m%u_perturb%PtFairDisplacement%TranslationDisp(1,:) + m%u_perturb%Y = m%u_perturb%PtFairDisplacement%Position(2,:) + m%u_perturb%PtFairDisplacement%TranslationDisp(2,:) + m%u_perturb%Z = m%u_perturb%PtFairDisplacement%Position(3,:) + m%u_perturb%PtFairDisplacement%TranslationDisp(3,:) - ! compute constraint state for u_op + delta u - call MSQS_UpdateStates( time , & - interval , & - u_perturb%C_obj , & - p%C_obj , & - x%C_obj , & - xd%C_obj , & - z_perturb%C_obj , & - OtherState%C_obj , & - status_from_MAP , & - message_from_MAP ) - - call MAP_ERROR_CHECKER(message_from_MAP,status_from_MAP,ErrMsg2,ErrStat2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg, RoutineName) - - ! compute y at u_op - delta u - call map_CalcOutput( t, u_perturb, p, x, xd, z_perturb, OtherState, y, 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 + ! compute constraint state for u_op - delta u + call MSQS_UpdateStates( time, & + interval, & + m%u_perturb%C_obj, & + p%C_obj, & + x%C_obj, & + xd%C_obj, & + m%z_lin%C_obj, & + OtherState%C_obj, & + status_from_MAP, & + message_from_MAP) + + call MAP_ERROR_CHECKER(message_from_MAP,status_from_MAP,ErrMsg2,ErrStat2); if (Failed()) return - ! We need to do this copy inside the loop because MAP++ (in the c-code) requires that the output data structure be y, which was used when MAP++ was initialized. - call map_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! compute y at u_op - delta u + ! MAP++ (in the c-code) requires that the output data structure be y, which was used when MAP++ was initialized. + call map_CalcOutput(t, m%u_perturb, p, x, xd, m%z_lin, OtherState, y, ErrStat2, ErrMsg2 ); if (Failed()) return + call MAP_VarsPackOutput(Vars, y, m%Jac%y_neg) - ! get central difference: note: assumes delta is equivalent for both perturb_u calls. - call Compute_dY( p, y_p, y_m, delta, dYdu(:,i) ) - + ! Calculate column index + col = Vars%u(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(Vars%y, Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) + end do end do end if - call cleanup() - - ! Calling CalcOutput at operating point to ensure that "y" does not have the values of y_m (MAP specific issue) - call map_CalcOutput( t, u, p, x, xd, z, OtherState, y, 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 -contains - subroutine cleanup() - call map_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call map_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call map_DestroyConstrState( z_perturb, ErrStat2, ErrMsg2 ) - call map_DestroyInput( u_perturb, ErrStat2, ErrMsg2 ) - - end subroutine cleanup -END SUBROUTINE MAP_JacobianPInput -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE MAP_GetOP( t, u, p, x, xd, z, OtherState, y, ErrStat, ErrMsg, u_op, y_op) - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(map_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(map_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(map_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(map_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(map_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(map_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(map_OutputType), INTENT(IN ) :: y !< Output at operating point - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - + ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + if (present(dXdu)) then + if (allocated(dXdu)) deallocate(dXdu) + end if + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the inputs (u) here: + if (present(dXddu)) then + if (allocated(dXddu)) deallocate(dXddu) + end if - INTEGER(IntKi) :: i, k, index, nu - INTEGER(IntKi) :: ny - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'map_GetOP' - TYPE(map_ContinuousStateType) :: dx !< derivative of continuous states at operating point - LOGICAL :: Mask(FIELDMASK_SIZE) !< flags to determine if this field is part of the packing + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the inputs (u) here: + if (present(dZdu)) then + if (allocated(dZdu)) deallocate(dZdu) + end if - !LIN-TODO: Need to review and implement this routine per plan. Do not understand how to implement at the moment, GJH. - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - - !.................................. - IF ( PRESENT( u_op ) ) THEN - - if (.not. allocated(u_op)) then - - nu = size(p%LinParams%Jac_u_indx,1) - - call AllocAry(u_op, nu,'u_op',ErrStat2,ErrMsg2) ! - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - - end if - - Mask = .false. - Mask(MASKID_TRANSLATIONDISP) = .true. - - index = 1 - if ( u%PtFairDisplacement%Committed ) then - call PackMotionMesh(u%PtFairDisplacement, u_op, index, FieldMask=Mask) - end if - - END IF - - !.................................. - if ( PRESENT( y_op ) ) then - - if (.not. allocated(y_op)) then - call AllocAry(y_op, p%LinParams%Jac_ny, 'y_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end if - - index = 1 - if ( y%ptFairleadLoad%Committed ) then - call PackLoadMesh(y%ptFairleadLoad, y_op, index) - end if - - index = index - 1 - do i=1,p%numOuts - y_op(i+index) = y%WriteOutput(i) - end do - - end if + ! Calling CalcOutput at operating point to ensure that "y" does not have the values of y_m (MAP specific issue) + call map_CalcOutput(t, u, p, x, xd, z, OtherState, y, ErrStat2, ErrMsg2); if (Failed()) return -END SUBROUTINE MAP_GetOP +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +END SUBROUTINE MAP_JacobianPInput !========================================================================================================== ! ========== MAP_ERROR_CHECKER ====== <-----------------------------------------------------------+ ! ! | - ! A convenient way to convert C-character arrays into a fortran string. The return argustment + ! A convenient way to convert C-character arrays into a fortran string. The return argument ! is a logical: False if program is safe; True if program fails in the MAP DLL SUBROUTINE MAP_ERROR_CHECKER(msg, stat, ErrMsg, ErrStat) CHARACTER(KIND=C_CHAR), DIMENSION(1024), INTENT(INOUT) :: msg diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index fdc69610ba..38d038fcee 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -47,7 +47,6 @@ MODULE MoorDyn PUBLIC :: MD_JacobianPInput PUBLIC :: MD_JacobianPDiscState PUBLIC :: MD_JacobianPConstrState - PUBLIC :: MD_GetOP CONTAINS @@ -2626,9 +2625,8 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er xd%dummy = 0 z%dummy = 0 - if (InitInp%Linearize) then - call MD_Init_Jacobian(InitInp, p, u, y, m, InitOut, ErrStat2, ErrMsg2); if(Failed()) return - endif + ! Initialize module variables + call MD_InitVars(InitOut%Vars, InitInp, u, p, x, z, y, m, InitOut, InitInp%Linearize, ErrStat2, ErrMsg2); if(Failed()) return CALL WrScr(' MoorDyn initialization completed.') if (p%writeLog > 0) then @@ -2739,8 +2737,334 @@ end function NextLine END SUBROUTINE MD_Init !----------------------------------------------------------------------------------------====== + !----------------------------------------------------------------------------------------------------------------------- + !> This routine initializes module variables for use by the solver and linearization. + subroutine MD_InitVars(Vars, InitInp, u, p, x, z, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(ModVarsType), intent(out) :: Vars !< Module variables + type(MD_InitInputType), intent(in) :: InitInp !< Initialization input + type(MD_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(MD_ParameterType), intent(inout) :: p !< Parameters + type(MD_ContinuousStateType), intent(inout) :: x !< Continuous state + type(MD_ConstraintStateType), intent(inout) :: z !< Constraint state + type(MD_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(MD_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(MD_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'MD_InitVars' + integer(IntKi) :: ErrStat2 ! Temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + integer(IntKi) :: i, j, l, N + real(R8Ki) :: Perturb + real(R8Ki) :: dl_slack ! how much a given line segment is stretched [m] + real(R8Ki) :: dl_slack_min ! minimum change in a node position for the least-strained segment in the simulation to go slack [m] + character(32) :: LinStr ! Used for constructing linearization variable names + logical :: LinCtrl ! Is the current DeltaL channel associated with a line? + type(ModVarType) :: VarTmp ! Temporary variable for velocity states + character(20), parameter :: TransDispSuffix(*) = [' Px, m', ' Py, m', ' Pz, m'] + character(20), parameter :: TransVelSuffix(*) = [' Vx, m/s', ' Vy, m/s', ' Vz, m/s'] + character(20), parameter :: AngularDispSuffix(*) = [' rot_x, rad', ' rot_y, rad', ' rot_z, rad'] + character(20), parameter :: AngularVelSuffix(*) = [' omega_x, rad/s', ' omega_y, rad/s', ' omega_z, rad/s'] + + ErrStat = ErrID_None + ErrMsg = "" + + !------------------------------------------------------------------------- + ! Perturbation sizes + !------------------------------------------------------------------------- + + ! Figure out appropriate transverse perturbation size to avoid slack segments + dl_slack_min = 0.1_ReKi ! start at 0.1 m + + do l = 1,p%nLines + do I = 1, m%LineList(l)%N + dl_slack = m%LineList(l)%lstr(I) - m%LineList(l)%l(I) + + ! store the smallest positive length margin to a segment going slack + if (( dl_slack > 0.0_ReKi) .and. (dl_slack < dl_slack_min)) then + dl_slack_min = dl_slack + end if + end do + end do + + dl_slack_min = 0.5*dl_slack_min ! apply 0.5 safety factor + + !------------------------------------------------------------------------- + ! Continuous State Variables + !------------------------------------------------------------------------- + + ! NOTE: the order is different than the order of the internal states. This is to + ! match what the OpenFAST framework is expecting: all positions first, then all + ! derviatives of positions (velocity terms) second. This adds slight complexity + ! here, but considerably simplifies post processing of the full OpenFAST results + ! for linearization. + ! The p%dxIdx_map2_xStateIdx array holds the index for the x%states array + ! corresponding to the current jacobian index. + + !----------------- + ! position states + !----------------- + + ! Free bodies + DO l = 1, p%nFreeBodies ! Body m%BodyList(m%FreeBodyIs(l)) + LinStr = 'Body '//Num2LStr(m%FreeBodyIs(l)) + + ! If coupled pinned body + if (m%BodyList(m%FreeBodyIs(l))%typeNum == 2) then + ! Add angular displacement + call MV_AddVar(Vars%x, LinStr, FieldAngularDisp, & + DL=DatLoc(MD_x_states), & + iAry=m%BodyStateIs1(l)+3, & + Num=3, Flags=VF_DerivOrder2, & + Perturb=0.02_R8Ki, & + LinNames=[(trim(LinStr)//AngularDispSuffix(j), j=1,3)]) + else + ! Add translation displacement + call MV_AddVar(Vars%x, LinStr, FieldTransDisp, & + DL=DatLoc(MD_x_states), & + iAry=m%BodyStateIs1(l)+6, & + Num=3, Flags=VF_DerivOrder2, & + Perturb=dl_slack_min, & + LinNames=[(trim(LinStr)//TransDispSuffix(j), j=1,3)]) + ! Add angular displacement + call MV_AddVar(Vars%x, LinStr, FieldAngularDisp, & + DL=DatLoc(MD_x_states), & + iAry=m%BodyStateIs1(l)+9, & + Num=3, Flags=VF_DerivOrder2, & + Perturb=0.02_R8Ki, & + LinNames=[(trim(LinStr)//AngularDispSuffix(j), j=1,3)]) + end if + end do + + ! Rods + DO l = 1,p%nFreeRods ! Rod m%RodList(m%FreeRodIs(l)) + LinStr = 'Rod '//Num2LStr(m%FreeRodIs(l)) + + ! If pinned rod + if (abs(m%RodList(m%FreeRodIs(l))%typeNum) == 1) then + ! Add angular displacement + call MV_AddVar(Vars%x, LinStr, FieldAngularDisp, DatLoc(MD_x_states), & + iAry=m%RodStateIs1(l)+3, & + Num=3, Flags=VF_DerivOrder2, & + Perturb=0.02_R8Ki, & + LinNames=[(trim(LinStr)//AngularDispSuffix(j), j=1,3)]) + else + ! Add translation displacement + call MV_AddVar(Vars%x, LinStr, FieldTransDisp, DatLoc(MD_x_states), & + iAry=m%RodStateIs1(l)+6, & + Num=3, Flags=VF_DerivOrder2, & + Perturb=dl_slack_min, & + LinNames=[(trim(LinStr)//TransDispSuffix(j), j=1,3)]) + ! Add angular displacement + call MV_AddVar(Vars%x, LinStr, FieldAngularDisp, DatLoc(MD_x_states), & + iAry=m%RodStateIs1(l)+9, & + Num=3, Flags=VF_DerivOrder2, & + Perturb=0.02_R8Ki, & + LinNames=[(trim(LinStr)//AngularDispSuffix(j), j=1,3)]) + end if + end do + + ! Free Points + do l = 1, p%nFreePoints ! Point m%PointList(m%FreePointIs(l)) + ! corresponds to state indices: (m%PointStateIs1(l)+3:m%PointStateIs1(l)+5) + LinStr = 'Point '//Num2LStr(m%FreePointIs(l)) + call MV_AddVar(Vars%x, LinStr, FieldTransDisp, DatLoc(MD_x_states), & + iAry=m%PointStateIs1(l)+3, & ! x%state index + Num=3, Flags=VF_DerivOrder2, & + Perturb=dl_slack_min, & + LinNames=[(trim(LinStr)//TransDispSuffix(j), j=1,3)]) + end do + + ! Lines + do l = 1, p%nLines ! Line m%LineList(l) + ! corresponds to state indices: (m%LineStateIs1(l)+3*N-3:m%LineStateIs1(l)+6*N-7) -- NOTE: end nodes not included + N = m%LineList(l)%N ! number of segments in the line + do i = 0, N-2 + LinStr = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1)) + call MV_AddVar(Vars%x, LinStr, FieldTransDisp, DatLoc(MD_x_states), & + iAry=m%LineStateIs1(l) + 3*N + 3*i - 3, & ! x%state index + Num=3, Flags=VF_DerivOrder2, & + Perturb=dl_slack_min, & + LinNames=[(trim(LinStr)//TransDispSuffix(j), j=1,3)]) + end do + end do + + !----------------- + ! velocity states + !----------------- + + ! Free bodies + DO l = 1, p%nFreeBodies ! Body m%BodyList(m%FreeBodyIs(l)) + LinStr = 'Body '//Num2LStr(m%FreeBodyIs(l)) + + ! If coupled pinned body + if (m%BodyList(m%FreeBodyIs(l))%typeNum == 2) then + ! Add angular displacement + call MV_AddVar(Vars%x, LinStr, FieldAngularVel, DatLoc(MD_x_states), & + iAry=m%BodyStateIs1(l)+0, & + Num=3, Flags=VF_DerivOrder2, & + Perturb=0.1_R8Ki, & + LinNames=[(trim(LinStr)//AngularVelSuffix(j), j=1,3)]) + else + ! Add translation displacement + call MV_AddVar(Vars%x, LinStr, FieldTransVel, DatLoc(MD_x_states), & + iAry=m%BodyStateIs1(l)+0, & + Num=3, Flags=VF_DerivOrder2, & + Perturb=0.1_R8Ki, & + LinNames=[(trim(LinStr)//TransVelSuffix(j), j=1,3)]) + ! Add angular displacement + call MV_AddVar(Vars%x, LinStr, FieldAngularVel, DatLoc(MD_x_states), & + iAry=m%BodyStateIs1(l)+3, & + Num=3, Flags=VF_DerivOrder2, & + Perturb=0.1_R8Ki, & + LinNames=[(trim(LinStr)//AngularVelSuffix(j), j=1,3)]) + end if + end do + + ! Rods + DO l = 1,p%nFreeRods ! Rod m%RodList(m%FreeRodIs(l)) + LinStr = 'Rod '//Num2LStr(m%FreeRodIs(l)) + + ! If pinned rod + if (abs(m%RodList(m%FreeRodIs(l))%typeNum) == 1) then + ! Add angular displacement + call MV_AddVar(Vars%x, LinStr, FieldAngularVel, DatLoc(MD_x_states), & + iAry=m%RodStateIs1(l)+0, & + Num=3, Flags=VF_DerivOrder2, & + Perturb=0.1_R8Ki, & + LinNames=[(trim(LinStr)//AngularVelSuffix(j), j=1,3)]) + else + ! Add translation displacement + call MV_AddVar(Vars%x, LinStr, FieldTransVel, DatLoc(MD_x_states), & + iAry=m%RodStateIs1(l)+0, & + Num=3, Flags=VF_DerivOrder2, & + Perturb=0.1_R8Ki, & + LinNames=[(trim(LinStr)//TransVelSuffix(j), j=1,3)]) + ! Add angular displacement + call MV_AddVar(Vars%x, LinStr, FieldAngularVel, DatLoc(MD_x_states), & + iAry=m%RodStateIs1(l)+3, & + Num=3, Flags=VF_DerivOrder2, & + Perturb=0.02_R8Ki, & + LinNames=[(trim(LinStr)//AngularVelSuffix(j), j=1,3)]) + end if + end do + + ! Free Points + do l = 1, p%nFreePoints ! Point m%PointList(m%FreePointIs(l)) + ! corresponds to state indices: (m%PointStateIs1(l)+3:m%PointStateIs1(l)+5) + LinStr = 'Point '//Num2LStr(m%FreePointIs(l)) + call MV_AddVar(Vars%x, LinStr, FieldTransVel, DatLoc(MD_x_states), & + iAry=m%PointStateIs1(l)+0, & + Num=3, Flags=VF_DerivOrder2, & + Perturb=0.1_R8Ki, & + LinNames=[(trim(LinStr)//TransVelSuffix(j), j=1,3)]) + end do + + ! Lines + do l = 1, p%nLines ! Line m%LineList(l) + ! corresponds to state indices: (m%LineStateIs1(l)+3*N-3:m%LineStateIs1(l)+6*N-7) -- NOTE: end nodes not included + N = m%LineList(l)%N ! number of segments in the line + do i = 0, N-2 + LinStr = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1)) + call MV_AddVar(Vars%x, LinStr, FieldTransVel, DatLoc(MD_x_states), & + iAry=m%LineStateIs1(l) + 3*i + 0, & + Num=3, Flags=VF_DerivOrder2, & + Perturb=0.1_R8Ki, & + LinNames=[(trim(LinStr)//TransVelSuffix(j), j=1,3)]) + end do + end do + + !------------------------------------------------------------------------- + ! Input variables + !------------------------------------------------------------------------- + + allocate(Vars%u(0)) + + do i = 1, p%nTurbines + call MV_AddMeshVar(Vars%u, "CoupledKinematics", MotionFields, & + DatLoc(MD_u_CoupledKinematics, i), & + Mesh=u%CoupledKinematics(i), & + Perturbs=[dl_slack_min, & ! FieldTransDisp + 0.1_R8Ki, & ! FieldOrientation + 0.1_R8Ki, & ! FieldTransVel + 0.1_R8Ki, & ! FieldAngularVel + 0.1_R8Ki, & ! FieldTransAcc + 0.1_R8Ki]) ! FieldAngularAcc + end do + + ! This could be stored more efficiently, but maintains order compatible with previous implementation. + if (allocated(u%DeltaL)) then + + ! Signals may be passed in without being requested for control + do i = 1,size(u%DeltaL) + + ! Figure out if this DeltaL control channel is associated with a line or multiple or none and label + LinCtrl = .FALSE. + LinStr = '(lines: ' + do j = 1, p%NLines + if (m%LineList(j)%CtrlChan == i) then + LinCtrl = .TRUE. + LinStr = LinStr//trim(num2lstr(i))//' ' + endif + enddo + + if (LinCtrl) then + LinStr = LinStr//' )' + else + LinStr = '(lines: none)' + end if + + call MV_AddVar(Vars%u, "DeltaL "//trim(num2lstr(i)), FieldTransDisp, & + DatLoc(MD_u_DeltaL), iAry=i, & + Perturb=dl_slack_min, & + LinNames=['CtrlChan DeltaL '//trim(num2lstr(i))//', m '//trim(LinStr)]) + + call MV_AddVar(Vars%u, "DeltaLdot "//trim(num2lstr(i)), FieldTransVel, & + DatLoc(MD_u_DeltaLdot), iAry=i, & + Perturb=0.2_R8Ki, & + LinNames=['CtrlChan DeltaLdot '//trim(num2lstr(i))//', m/s'//trim(LinStr)]) + end do + endif + !------------------------------------------------------------------------- + ! Output variables + !------------------------------------------------------------------------- + do i = 1, p%nTurbines + call MV_AddMeshVar(Vars%y, "LinNames_y", LoadFields, & + DatLoc(MD_y_CoupledLoads, i), & + Mesh=y%CoupledLoads(i)) + end do + + ! Write outputs + call MV_AddVar(Vars%y, "WriteOutput", FieldScalar, DatLoc(MD_y_WriteOutput), & + Flags=VF_WriteOut, & + Num=p%numOuts,& + LinNames=[(WriteOutputLinName(i), i = 1, p%numOuts)]) + + !------------------------------------------------------------------------- + ! Initialize Variables and Jacobian data + !------------------------------------------------------------------------- + + CALL MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + call MD_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call MD_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call MD_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call MD_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + + contains + character(LinChanLen) function WriteOutputLinName(idx) + integer(IntKi), intent(in) :: idx + WriteOutputLinName = trim(InitOut%WriteOutputHdr(idx))//', '//trim(InitOut%WriteOutputUnt(idx)) + end function + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed + end subroutine !----------------------------------------------------------------------------------------====== SUBROUTINE MD_UpdateStates( t, n, u, t_array, p, x, xd, z, other, m, ErrStat, ErrMsg) @@ -3291,7 +3615,7 @@ SUBROUTINE MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, dxdt, ErrStat, Er INTEGER(IntKi) :: J ! index INTEGER(IntKi) :: K ! index INTEGER(IntKi) :: iTurb ! index -! INTEGER(IntKi) :: Istart ! start index of line/point in state vector +! INTEGER(IntKi) :: iAry ! start index of line/point in state vector ! INTEGER(IntKi) :: Iend ! end index of line/point in state vector ! REAL(DbKi) :: temp(3) ! temporary for passing kinematics @@ -3859,7 +4183,8 @@ END SUBROUTINE TimeStep !---------------------------------------------------------------------------------------------------------------------------------- !> 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 MD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +SUBROUTINE MD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) + type(ModVarsType), INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(MD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(MD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -3877,99 +4202,111 @@ SUBROUTINE MD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) wrt the inputs (u) [intent in to avoid deallocation] ! local variables - TYPE(MD_OutputType) :: y_m, y_p - TYPE(MD_ContinuousStateType) :: x_m, x_p - TYPE(MD_InputType) :: u_perturb - REAL(R8Ki) :: delta_p, delta_m ! delta change in input (plus, minus) - INTEGER(IntKi) :: i - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'MD_JacobianPInput' - - ! Initialize ErrStat + character(*), parameter :: RoutineName = 'MD_JacobianPInput' + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + INTEGER(IntKi) :: i, j, iCol + ErrStat = ErrID_None ErrMsg = '' + + ! Get OP values here + call MD_CalcOutput(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2); if(Failed()) return - ! get OP values here: - call MD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ); if(Failed()) return - - ! make a copy of the inputs to perturb - call MD_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return + ! Copy inputs to perturb + call MD_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call MD_VarsPackInput(Vars, u, m%Jac%u) - IF ( PRESENT( dYdu ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: - if (.not. allocated(dYdu) ) then - call AllocAry(dYdu, p%Jac_ny, size(p%Jac_u_indx,1),'dYdu', ErrStat2, ErrMsg2); if(Failed()) return + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + if (present(dYdu)) then + + ! Allocate dYdu if not allocated + if (.not. allocated(dYdu)) then + call AllocAry(dYdu, m%Jac%Ny, m%Jac%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call MD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - call MD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - do i=1,size(p%Jac_u_indx,1) - ! get u_op + delta_p u - call MD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_Perturb_u( p, i, 1, u_perturb, delta_p ) - ! compute y at u_op + delta_p u - call MD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get u_op - delta_m u - call MD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_Perturb_u( p, i, -1, u_perturb, delta_m ) - ! compute y at u_op - delta_m u - call MD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get central difference: - call MD_Compute_dY( p, y_p, y_m, delta_p, dYdu(:,i) ) + + ! Loop through input variables + do i = 1, size(Vars%u) + + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%u(i)%Num + + ! Calculate column index + iCol = Vars%u(i)%iLoc(1) + j - 1 + + ! Calculate positive perturbation + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call MD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call MD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call MD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call MD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call MD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call MD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) + + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(Vars%y, Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,iCol)) + end do end do - if(Failed()) return END IF - IF ( PRESENT( dXdu ) ) THEN + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + if (present(dXdu)) then + + ! Allocate dXdu if not allocated if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%Jac_nx, size(p%Jac_u_indx,1), 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return - endif - do i=1,size(p%Jac_u_indx,1) - ! get u_op + delta u - call MD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_Perturb_u( p, i, 1, u_perturb, delta_p ) - ! compute x at u_op + delta u - call MD_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get u_op - delta u - call MD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_Perturb_u( p, i, -1, u_perturb, delta_m ) - ! compute x at u_op - delta u - call MD_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get central difference: - ! we may have had an error allocating memory, so we'll check - if(Failed()) return - ! get central difference (state entries are mapped the the dXdu column in routine): - call MD_Compute_dX( p, x_p, x_m, delta_p, dXdu(:,i) ) + call AllocAry(dXdu, m%Jac%Nx, m%Jac%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return + end if + + ! Loop through input variables + do i = 1, size(Vars%u) + + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%u(i)%Num + + ! Calculate column index + iCol = Vars%u(i)%iLoc(1) + j - 1 + + ! Calculate positive perturbation + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call MD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call MD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call MD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call MD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call MD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call MD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_neg) + + ! Get partial derivative via central difference and store in full linearization array + dXdu(:,iCol) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%u(i)%Perturb) + end do end do - END IF ! dXdu - 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 + end if ! dXdu + + if (present(dxddu)) then + if (allocated(dxddu)) deallocate(dxddu) + end if + + if (present(dzdu)) then + if (allocated(dzdu)) deallocate(dzdu) + end if + +contains logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() end function Failed - - subroutine CleanUp() - call MD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call MD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - call MD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call MD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call MD_DestroyInput(u_perturb, ErrStat2, ErrMsg2 ) - end subroutine cleanup - END SUBROUTINE MD_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE MD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx) +SUBROUTINE MD_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx) + type(ModVarsType), INTENT(IN ) :: Vars !< Module variables for packing arrays REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(MD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(MD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -3985,98 +4322,103 @@ SUBROUTINE MD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) wrt the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) wrt the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) wrt the continuous states (x) [intent in to avoid deallocation] + ! local variables - TYPE(MD_OutputType) :: y_p, y_m - TYPE(MD_ContinuousStateType) :: x_p, x_m - TYPE(MD_ContinuousStateType) :: x_perturb - REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_JacobianPContState' - - ! Initialize ErrStat + character(*), parameter :: RoutineName = 'MD_JacobianPContState' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, iCol + ErrStat = ErrID_None ErrMsg = '' - ! make a copy of the continuous states to perturb NOTE: MESH_NEWCOPY - call MD_CopyContState( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return + ! Copy state values + call MD_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call MD_VarsPackContState(Vars, x, m%Jac%x) - IF ( PRESENT( dYdx ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + if (present(dYdx)) then + + ! Allocate dYdx if not allocated if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Jac_ny, p%Jac_nx, 'dYdx', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(dYdx, m%Jac%Ny, m%Jac%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return end if - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call MD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - ! Loop over the dx dimension of the dYdx array. Perturb the corresponding state (note difference in ordering of dYdx and x%states). - ! The p%dxIdx_map2_xStateIdx(i) is the index to the state array for the given dx index - do i=1,p%Jac_nx ! index into dx dimension - ! get x_op + delta x - call MD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_perturb_x(p, i, 1, x_perturb, delta ) - ! compute y at x_op + delta x - call MD_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get x_op - delta x - call MD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_perturb_x(p, i, -1, x_perturb, delta ) - ! compute y at x_op - delta x - call MD_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get central difference: - call MD_Compute_dY( p, y_p, y_m, delta, dYdx(:,i) ) + + ! Loop through state variables + do i = 1, size(Vars%x) + + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%x(i)%Num + + ! Calculate column index + iCol = Vars%x(i)%iLoc(1) + j - 1 + + ! Calculate positive perturbation + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call MD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call MD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call MD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call MD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call MD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call MD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) + + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(Vars%y, Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,iCol)) + end do end do - if(Failed()) return - END IF - - IF ( PRESENT( dXdx ) ) THEN - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + end if + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + if (present(dXdx)) then + + ! Allocate dXdx if not allocated if (.not. allocated(dXdx)) then - call AllocAry(dXdx, p%Jac_nx, p%Jac_nx, 'dXdx', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(dXdx, m%Jac%Nx, m%Jac%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return end if - ! Loop over the dx dimension of the array. Perturb the corresponding state (note difference in ordering of dXdx and x%states). - ! The resulting x_p and x_m are used to calculate the column for dXdx (mapping of state entry to dXdx row entry occurs in MD_Compute_dX) - ! The p%dxIdx_map2_xStateIdx(i) is the index to the state array for the given dx index - do i=1,p%Jac_nx ! index into dx dimension - ! get x_op + delta x - call MD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_perturb_x(p, i, 1, x_perturb, delta ) - ! compute x at x_op + delta x - call MD_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get x_op - delta x - call MD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_perturb_x(p, i, -1, x_perturb, delta ) - ! compute x at x_op - delta x - call MD_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if(Failed()) return - ! get central difference: - call MD_Compute_dX( p, x_p, x_m, delta, dXdx(:,i) ) + + ! Loop through state variables + do i = 1, size(Vars%x) + + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%x(i)%Num + + ! Calculate column index + iCol = Vars%x(i)%iLoc(1) + j - 1 + + ! Calculate positive perturbation + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call MD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call MD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call MD_VarsPackContStateDeriv(Vars, m%dxdt_lin, m%Jac%x_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call MD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call MD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call MD_VarsPackContStateDeriv(Vars, m%dxdt_lin, m%Jac%x_neg) + + ! Get partial derivative via central difference and store in full linearization array + dXdx(:,iCol) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%x(i)%Perturb) + end do end do - END IF - IF ( PRESENT( dXddx ) ) THEN + end if + + if (present(dXddx)) then if (allocated(dXddx)) deallocate(dXddx) - END IF - IF ( PRESENT( dZdx ) ) THEN + end if + + if (present(dZdx)) then if (allocated(dZdx)) deallocate(dZdx) - END IF - call CleanUp() + end if contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MD_JacobianPContState') + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() end function Failed - - subroutine CleanUp() - call MD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call MD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call MD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call MD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) - call MD_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) - end subroutine cleanup - END SUBROUTINE MD_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- @@ -4145,609 +4487,5 @@ SUBROUTINE MD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat IF ( PRESENT(dZdz) ) THEN END IF END SUBROUTINE MD_JacobianPConstrState -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE MD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(MD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(MD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(MD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(MD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(MD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(MD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(MD_OutputType), INTENT(IN ) :: y !< Output at operating point - TYPE(MD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - ! Local - INTEGER(IntKi) :: idx, i - INTEGER(IntKi) :: nu - INTEGER(IntKi) :: ny - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_GetOP' - LOGICAL :: FieldMask(FIELDMASK_SIZE) - TYPE(MD_ContinuousStateType) :: dx ! derivative of continuous states at operating point - ErrStat = ErrID_None - ErrMsg = '' - ! inputs - IF ( PRESENT( u_op ) ) THEN - nu = size(p%Jac_u_indx,1) + u%CoupledKinematics(1)%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM (thus 6 more per node) - if (.not. allocated(u_op)) then - call AllocAry(u_op, nu, 'u_op', ErrStat2, ErrMsg2); if(Failed()) return - end if - idx = 1 - FieldMask = .false. - FieldMask(MASKID_TranslationDisp) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TranslationVel) = .true. - FieldMask(MASKID_RotationVel) = .true. - FieldMask(MASKID_TranslationAcc) = .true. - FieldMask(MASKID_RotationAcc) = .true. - ! fill in the u_op values from the input mesh - call PackMotionMesh(u%CoupledKinematics(1), u_op, idx, FieldMask=FieldMask) - - ! now do the active tensioning commands if there are any - if (allocated(u%DeltaL)) then - do i=1,size(u%DeltaL) - u_op(idx) = u%DeltaL(i) - idx = idx + 1 - u_op(idx) = u%DeltaLdot(i) - idx = idx + 1 - end do - endif - END IF - ! outputs - IF ( PRESENT( y_op ) ) THEN - ny = p%Jac_ny + y%CoupledLoads(1)%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 - call AllocAry(y_op, ny, 'y_op', ErrStat2, ErrMsg2); if(Failed()) return - end if - idx = 1 - call PackLoadMesh(y%CoupledLoads(1), y_op, idx) - do i=1,p%NumOuts - y_op(idx) = y%WriteOutput(i) - idx = idx + 1 - end do - END IF - ! states - IF ( PRESENT( x_op ) ) THEN - if (.not. allocated(x_op)) then - call AllocAry(x_op, p%Jac_nx,'x_op',ErrStat2,ErrMsg2); if (Failed()) return - end if - do i=1, p%Jac_nx - x_op(i) = x%states(p%dxIdx_map2_xStateIdx(i)) ! x for lin is different order, so use mapping - end do - END IF - ! state derivatives? - IF ( PRESENT( dx_op ) ) THEN - if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%Jac_nx,'dx_op',ErrStat2,ErrMsg2); if(failed()) return - end if - call MD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dx, ErrStat2, ErrMsg2 ) ; if(Failed()) return - do i=1, p%Jac_nx - dx_op(i) = dx%states(p%dxIdx_map2_xStateIdx(i)) ! x for lin is different order, so use mapping - end do - END IF - IF ( PRESENT( xd_op ) ) THEN - ! pass - END IF - IF ( PRESENT( z_op ) ) THEN - ! pass - END IF - call CleanUp() -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MD_GetOP') - Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() - end function Failed - - subroutine CleanUp() - call MD_DestroyContState(dx, ErrStat2, ErrMsg2); - end subroutine -END SUBROUTINE MD_GetOP - - - -!==================================================================================================== -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> This routine initializes the array that maps rows/columns of the Jacobian to specific mesh fields. -!! Do not change the order of this packing without changing subroutines calculating dXdx etc (MD_Compute_dX) -SUBROUTINE MD_Init_Jacobian(Init, p, u, y, m, InitOut, ErrStat, ErrMsg) - TYPE(MD_InitInputType) , INTENT(IN ) :: Init !< Init - TYPE(MD_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(MD_InputType) , INTENT(IN ) :: u !< inputs - TYPE(MD_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(MD_MiscVarType) , INTENT(INOUT) :: m !< misc variables <<<<<<<< - TYPE(MD_InitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) - 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 = 'SD_Init_Jacobian' -! real(ReKi) :: dx, dy, dz, maxDim - - INTEGER(IntKi) :: l, I - real(ReKi) :: dl_slack ! how much a given line segment is stretched [m] - real(ReKi) :: dl_slack_min ! minimum change in a node position for the least-strained segment in the simulation to go slack [m] - - - ! local variables: - ErrStat = ErrID_None - ErrMsg = "" - - !! --- System dimension - !dx = maxval(Init%Nodes(:,2))- minval(Init%Nodes(:,2)) - !dy = maxval(Init%Nodes(:,3))- minval(Init%Nodes(:,3)) - !dz = maxval(Init%Nodes(:,4))- minval(Init%Nodes(:,4)) - !maxDim = max(dx, dy, dz) - - - ! Figure out appropriate transverse perturbation size to avoid slack segments - dl_slack_min = 0.1_ReKi ! start at 0.1 m - - do l = 1,p%nLines - do I = 1, m%LineList(l)%N - dl_slack = m%LineList(l)%lstr(I) - m%LineList(l)%l(I) - - ! store the smallest positive length margin to a segment going slack - if (( dl_slack > 0.0_ReKi) .and. (dl_slack < dl_slack_min)) then - dl_slack_min = dl_slack - end if - end do - end do - - dl_slack_min = 0.5*dl_slack_min ! apply 0.5 safety factor - - !TODO: consider attachment radii to also produce a rotational perturbation size from the above - - - ! --- System dimension - call Init_Jacobian_y(); if (Failed()) return - call Init_Jacobian_x(); if (Failed()) return - call Init_Jacobian_u(); if (Failed()) return - -contains - LOGICAL FUNCTION Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_Init_Jacobian') - Failed = ErrStat >= AbortErrLev - END FUNCTION Failed - - !> This routine initializes the Jacobian parameters and initialization outputs for the linearized outputs. - SUBROUTINE Init_Jacobian_y() - INTEGER(IntKi) :: index_next, i - - ! Number of outputs - p%Jac_ny = y%CoupledLoads(1)%nNodes * 6 & ! 3 forces + 3 moments at each node (moments may be zero) - + p%NumOuts ! WriteOutput values - ! Storage info for each output (names, rotframe) - call AllocAry(InitOut%LinNames_y, p%Jac_ny, 'LinNames_y',ErrStat2,ErrMsg2); if(ErrStat2/=ErrID_None) return - call AllocAry(InitOut%RotFrame_y, p%Jac_ny, 'RotFrame_y',ErrStat2,ErrMsg2); if(ErrStat2/=ErrID_None) return - ! Names - index_next = 1 - call PackLoadMesh_Names( y%CoupledLoads(1), 'LinNames_y', InitOut%LinNames_y, index_next) ! <<< should a specific name be provided here? - do i=1,p%NumOuts - InitOut%LinNames_y(i+index_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) - end do - - InitOut%RotFrame_y(:) = .false. - END SUBROUTINE Init_Jacobian_y - - !> This routine initializes the Jacobian parameters and initialization outputs for the linearized continuous states. - SUBROUTINE Init_Jacobian_x() - INTEGER(IntKi) :: idx ! index into the LinNames_x array - INTEGER(IntKi) :: i - INTEGER(IntKi) :: l - INTEGER(IntKi) :: N - - - p%Jac_nx = m%Nx ! size of (continuous) state vector (includes the first derivatives) - - ! allocate space for the row/column names and for perturbation sizes - CALL AllocAry(InitOut%LinNames_x , p%Jac_nx, 'LinNames_x' , ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return - CALL AllocAry(InitOut%RotFrame_x , p%Jac_nx, 'RotFrame_x' , ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return - CALL AllocAry(InitOut%DerivOrder_x , p%Jac_nx, 'DerivOrder_x' , ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return - CALL AllocAry(p%dx , p%Jac_nx, 'p%dx' , ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return - CALL AllocAry(p%dxIdx_map2_xStateIdx, p%Jac_nx, 'p%dxIdx_map2_xStateIdx', ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return - - p%dxIdx_map2_xStateIdx = 0_IntKi ! all values should be overwritten by logic below - - ! set linearization output names and default perturbations, p%dx: - ! NOTE: the order is different than the order of the internal states. This is to - ! match what the OpenFAST framework is expecting: all positions first, then all - ! derviatives of positions (velocity terms) second. This adds slight complexity - ! here, but considerably simplifies post processing of the full OpenFAST results - ! for linearization. - ! The p%dxIdx_map2_xStateIdx array holds the index for the x%states array - ! corresponding to the current jacobian index. - - !----------------- - ! position states - !----------------- - idx = 0 - ! Free bodies - DO l = 1,p%nFreeBodies ! Body m%BodyList(m%FreeBodyIs(l)) - if (m%BodyList(m%FreeBodyIs(l))%typeNum == 2) then ! Coupled pinned body - p%dx(idx+4:idx+6) = 0.02 ! body rotation [rad] - ! corresponds to state indices: (m%BodyStateIs1(l)+6:m%BodyStateIs1(l)+8) - InitOut%LinNames_x(idx+1) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_x, rad' - InitOut%LinNames_x(idx+2) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_y, rad' - InitOut%LinNames_x(idx+3) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_z, rad' - p%dxIdx_map2_xStateIdx(idx+4) = m%BodyStateIs1(l)+3 ! x%state index for rot_x - p%dxIdx_map2_xStateIdx(idx+5) = m%BodyStateIs1(l)+4 ! x%state index for rot_y - p%dxIdx_map2_xStateIdx(idx+6) = m%BodyStateIs1(l)+5 ! x%state index for rot_z - idx = idx + 3 - else ! free body - p%dx(idx+1:idx+3) = dl_slack_min ! body displacement [m] - p%dx(idx+4:idx+6) = 0.02 ! body rotation [rad] - ! corresponds to state indices: (m%BodyStateIs1(l)+6:m%BodyStateIs1(l)+11) - InitOut%LinNames_x(idx+1) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Px, m' - InitOut%LinNames_x(idx+2) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Py, m' - InitOut%LinNames_x(idx+3) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Pz, m' - InitOut%LinNames_x(idx+4) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_x, rad' - InitOut%LinNames_x(idx+5) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_y, rad' - InitOut%LinNames_x(idx+6) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_z, rad' - p%dxIdx_map2_xStateIdx(idx+1) = m%BodyStateIs1(l)+6 ! x%state index for Px - p%dxIdx_map2_xStateIdx(idx+2) = m%BodyStateIs1(l)+7 ! x%state index for Py - p%dxIdx_map2_xStateIdx(idx+3) = m%BodyStateIs1(l)+8 ! x%state index for Pz - p%dxIdx_map2_xStateIdx(idx+4) = m%BodyStateIs1(l)+9 ! x%state index for rot_x - p%dxIdx_map2_xStateIdx(idx+5) = m%BodyStateIs1(l)+10 ! x%state index for rot_y - p%dxIdx_map2_xStateIdx(idx+6) = m%BodyStateIs1(l)+11 ! x%state index for rot_z - idx = idx + 6 - endif - END DO - - ! Rods - DO l = 1,p%nFreeRods ! Rod m%RodList(m%FreeRodIs(l)) - if (abs(m%RodList(m%FreeRodIs(l))%typeNum) == 1) then ! pinned rod - p%dx(idx+1:idx+3) = 0.02 ! rod rotation [rad] - ! corresponds to state indices: (m%RodStateIs1(l)+3:m%RodStateIs1(l)+5) - InitOut%LinNames_x(idx+1) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_x, rad' - InitOut%LinNames_x(idx+2) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_y, rad' - InitOut%LinNames_x(idx+3) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_z, rad' - p%dxIdx_map2_xStateIdx(idx+4) = m%RodStateIs1(l)+3 ! x%state index for rot_x - p%dxIdx_map2_xStateIdx(idx+5) = m%RodStateIs1(l)+4 ! x%state index for rot_y - p%dxIdx_map2_xStateIdx(idx+6) = m%RodStateIs1(l)+5 ! x%state index for rot_z - idx = idx + 3 - else ! free rod - p%dx(idx+1:idx+3) = dl_slack_min ! rod displacement [m] - p%dx(idx+4:idx+6) = 0.02 ! rod rotation [rad] - ! corresponds to state indices: (m%RodStateIs1(l)+6:m%RodStateIs1(l)+11) - InitOut%LinNames_x(idx+1) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Px, m' - InitOut%LinNames_x(idx+2) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Py, m' - InitOut%LinNames_x(idx+3) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Pz, m' - InitOut%LinNames_x(idx+4) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_x, rad' - InitOut%LinNames_x(idx+5) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_y, rad' - InitOut%LinNames_x(idx+6) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_z, rad' - p%dxIdx_map2_xStateIdx(idx+1) = m%RodStateIs1(l)+6 ! x%state index for Px - p%dxIdx_map2_xStateIdx(idx+2) = m%RodStateIs1(l)+7 ! x%state index for Py - p%dxIdx_map2_xStateIdx(idx+3) = m%RodStateIs1(l)+8 ! x%state index for Pz - p%dxIdx_map2_xStateIdx(idx+4) = m%RodStateIs1(l)+9 ! x%state index for rot_x - p%dxIdx_map2_xStateIdx(idx+5) = m%RodStateIs1(l)+10 ! x%state index for rot_y - p%dxIdx_map2_xStateIdx(idx+6) = m%RodStateIs1(l)+11 ! x%state index for rot_z - idx = idx + 6 - end if - END DO - - ! Free Points - DO l = 1,p%nFreePoints ! Point m%PointList(m%FreePointIs(l)) - ! corresponds to state indices: (m%PointStateIs1(l)+3:m%PointStateIs1(l)+5) - p%dx(idx+1:idx+3) = dl_slack_min ! point displacement [m] - InitOut%LinNames_x(idx+1) = 'Point '//trim(num2lstr(m%FreePointIs(l)))//' Px, m' - InitOut%LinNames_x(idx+2) = 'Point '//trim(num2lstr(m%FreePointIs(l)))//' Py, m' - InitOut%LinNames_x(idx+3) = 'Point '//trim(num2lstr(m%FreePointIs(l)))//' Pz, m' - p%dxIdx_map2_xStateIdx(idx+1) = m%PointStateIs1(l)+3 ! x%state index for Px - p%dxIdx_map2_xStateIdx(idx+2) = m%PointStateIs1(l)+4 ! x%state index for Py - p%dxIdx_map2_xStateIdx(idx+3) = m%PointStateIs1(l)+5 ! x%state index for Pz - idx = idx + 3 - END DO - - ! Lines - DO l = 1,p%nLines ! Line m%LineList(l) - ! corresponds to state indices: (m%LineStateIs1(l)+3*N-3:m%LineStateIs1(l)+6*N-7) -- NOTE: end nodes not included - N = m%LineList(l)%N ! number of segments in the line - DO i = 0,N-2 - p%dx(idx+1:idx+3) = dl_slack_min ! line internal node displacement [m] - InitOut%LinNames_x(idx+1) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Px, m' - InitOut%LinNames_x(idx+2) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Py, m' - InitOut%LinNames_x(idx+3) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Pz, m' - p%dxIdx_map2_xStateIdx(idx+1) = m%LineStateIs1(l)+3*N+3*i-3 ! x%state index for Px - p%dxIdx_map2_xStateIdx(idx+2) = m%LineStateIs1(l)+3*N+3*i-2 ! x%state index for Py - p%dxIdx_map2_xStateIdx(idx+3) = m%LineStateIs1(l)+3*N+3*i-1 ! x%state index for Pz - idx = idx + 3 - END DO - END DO - - !----------------- - ! velocity states - !----------------- - ! Free bodies - DO l = 1,p%nFreeBodies ! Body m%BodyList(m%FreeBodyIs(l)) - if (m%BodyList(m%FreeBodyIs(l))%typeNum == 2) then ! Coupled pinned body - ! corresponds to state indices: (m%BodyStateIs1(l):m%BodyStateIs1(l)+5) - p%dx(idx+1:idx+3) = 0.1 ! body rotational velocity [rad/s] - InitOut%LinNames_x(idx+1) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_x, rad/s' - InitOut%LinNames_x(idx+2) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_y, rad/s' - InitOut%LinNames_x(idx+3) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_z, rad/s' - p%dxIdx_map2_xStateIdx(idx+1) = m%BodyStateIs1(l)+0 ! x%state index for omega_x - p%dxIdx_map2_xStateIdx(idx+2) = m%BodyStateIs1(l)+1 ! x%state index for omega_y - p%dxIdx_map2_xStateIdx(idx+3) = m%BodyStateIs1(l)+2 ! x%state index for omega_z - idx = idx + 3 - else !Free body - ! corresponds to state indices: (m%BodyStateIs1(l):m%BodyStateIs1(l)+5) - p%dx(idx+1:idx+3) = 0.1 ! body translational velocity [m/s] - p%dx(idx+4:idx+6) = 0.1 ! body rotational velocity [rad/s] - InitOut%LinNames_x(idx+1) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Vx, m/s' - InitOut%LinNames_x(idx+2) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Vy, m/s' - InitOut%LinNames_x(idx+3) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Vz, m/s' - InitOut%LinNames_x(idx+4) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_x, rad/s' - InitOut%LinNames_x(idx+5) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_y, rad/s' - InitOut%LinNames_x(idx+6) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_z, rad/s' - p%dxIdx_map2_xStateIdx(idx+1) = m%BodyStateIs1(l)+0 ! x%state index for Rx - p%dxIdx_map2_xStateIdx(idx+2) = m%BodyStateIs1(l)+1 ! x%state index for Ry - p%dxIdx_map2_xStateIdx(idx+3) = m%BodyStateIs1(l)+2 ! x%state index for Rz - p%dxIdx_map2_xStateIdx(idx+4) = m%BodyStateIs1(l)+3 ! x%state index for omega_x - p%dxIdx_map2_xStateIdx(idx+5) = m%BodyStateIs1(l)+4 ! x%state index for omega_y - p%dxIdx_map2_xStateIdx(idx+6) = m%BodyStateIs1(l)+5 ! x%state index for omega_z - idx = idx + 6 - endif - END DO - - ! Rods - DO l = 1,p%nFreeRods ! Rod m%RodList(m%FreeRodIs(l)) - if (abs(m%RodList(m%FreeRodIs(l))%typeNum) == 1) then ! pinned rod - ! corresponds to state indices: (m%RodStateIs1(l):m%RodStateIs1(l)+2) - p%dx(idx+1:idx+3) = 0.1 ! body rotational velocity [rad/s] - InitOut%LinNames_x(idx+1) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_x, rad/s' - InitOut%LinNames_x(idx+2) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_y, rad/s' - InitOut%LinNames_x(idx+3) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_z, rad/s' - p%dxIdx_map2_xStateIdx(idx+1) = m%RodStateIs1(l)+0 ! x%state index for Vx - p%dxIdx_map2_xStateIdx(idx+2) = m%RodStateIs1(l)+1 ! x%state index for Vy - p%dxIdx_map2_xStateIdx(idx+3) = m%RodStateIs1(l)+2 ! x%state index for Vz - idx = idx + 3 - else ! free rod - ! corresponds to state indices: (m%RodStateIs1(l):m%RodStateIs1(l)+5) - p%dx(idx+1:idx+3) = 0.1 ! body translational velocity [m/s] - p%dx(idx+4:idx+6) = 0.02 ! body rotational velocity [rad/s] - InitOut%LinNames_x(idx+1) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Vx, m/s' - InitOut%LinNames_x(idx+2) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Vy, m/s' - InitOut%LinNames_x(idx+3) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Vz, m/s' - InitOut%LinNames_x(idx+4) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_x, rad/s' - InitOut%LinNames_x(idx+5) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_y, rad/s' - InitOut%LinNames_x(idx+6) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_z, rad/s' - p%dxIdx_map2_xStateIdx(idx+1) = m%RodStateIs1(l)+0 ! x%state index for Vx - p%dxIdx_map2_xStateIdx(idx+2) = m%RodStateIs1(l)+1 ! x%state index for Vy - p%dxIdx_map2_xStateIdx(idx+3) = m%RodStateIs1(l)+2 ! x%state index for Vz - p%dxIdx_map2_xStateIdx(idx+4) = m%RodStateIs1(l)+3 ! x%state index for omega_x - p%dxIdx_map2_xStateIdx(idx+5) = m%RodStateIs1(l)+4 ! x%state index for omega_y - p%dxIdx_map2_xStateIdx(idx+6) = m%RodStateIs1(l)+5 ! x%state index for omega_z - idx = idx + 6 - end if - END DO - - ! Free Points - DO l = 1,p%nFreePoints ! Point m%PointList(m%FreePointIs(l)) - ! corresponds to state indices: (m%PointStateIs1(l):m%PointStateIs1(l)+2) - p%dx(idx+1:idx+3) = 0.1 ! point translational velocity [m/s] - InitOut%LinNames_x(idx+1) = 'Point '//trim(num2lstr(m%FreePointIs(l)))//' Vx, m/s' - InitOut%LinNames_x(idx+2) = 'Point '//trim(num2lstr(m%FreePointIs(l)))//' Vy, m/s' - InitOut%LinNames_x(idx+3) = 'Point '//trim(num2lstr(m%FreePointIs(l)))//' Vz, m/s' - p%dxIdx_map2_xStateIdx(idx+1) = m%PointStateIs1(l)+0 ! x%state index for Vx - p%dxIdx_map2_xStateIdx(idx+2) = m%PointStateIs1(l)+1 ! x%state index for Vy - p%dxIdx_map2_xStateIdx(idx+3) = m%PointStateIs1(l)+2 ! x%state index for Vz - idx = idx + 3 - END DO - - ! Lines - DO l = 1,p%nLines ! Line m%LineList(l) - ! corresponds to state indices: (m%LineStateIs1(l):m%LineStateIs1(l)+3*N-4) -- NOTE: end nodes not included - N = m%LineList(l)%N ! number of segments in the line - DO i = 0,N-2 - p%dx(idx+1:idx+3) = 0.1 ! line internal node translational velocity [m/s] - InitOut%LinNames_x(idx+1) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Vx, m/s' - InitOut%LinNames_x(idx+2) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Vy, m/s' - InitOut%LinNames_x(idx+3) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Vz, m/s' - p%dxIdx_map2_xStateIdx(idx+1) = m%LineStateIs1(l)+3*i+0 ! x%state index for Vx - p%dxIdx_map2_xStateIdx(idx+2) = m%LineStateIs1(l)+3*i+1 ! x%state index for Vy - p%dxIdx_map2_xStateIdx(idx+3) = m%LineStateIs1(l)+3*i+2 ! x%state index for Vz - idx = idx + 3 - END DO - END DO - - ! If a summary file is ever made... - ! !Formatting may be needed to make it pretty - ! if(UnSum > 0) then - ! write(UnSum,*) ' Lin_Jac_x idx x%state idx' - ! do i=1,p%Jac_nx - ! write(UnSum,*) InitOut%LinNames_x(i),' ',i,' ',p%dxIdx_map2_xStateIdx(i) - ! enddo - ! endif - - InitOut%RotFrame_x = .false. - InitOut%DerivOrder_x = 2 - END SUBROUTINE Init_Jacobian_x - - SUBROUTINE Init_Jacobian_u() - INTEGER(IntKi) :: i, j, idx, nu, i_meshField - character(10) :: LinStr ! for noting which line a DeltaL control is attached to - logical :: LinCtrl ! Is the current DeltaL channel associated with a line? - ! Number of inputs - i = 0 - if (allocated(u%DeltaL)) i=size(u%DeltaL) - nu = u%CoupledKinematics(1)%nNodes * 18 & ! 3 Translation Displacements + 3 orientations + 6 velocities + 6 accelerations at each node <<<<<<< - + i*2 ! a deltaL and rate of change for each active tension control channel - - ! --- Info of linearized inputs (Names, RotFrame, IsLoad) - call AllocAry(InitOut%LinNames_u, nu, 'LinNames_u', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return - call AllocAry(InitOut%RotFrame_u, nu, 'RotFrame_u', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return - call AllocAry(InitOut%IsLoad_u , nu, 'IsLoad_u' , ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return - - InitOut%IsLoad_u = .false. ! None of MoorDyn's inputs are loads - InitOut%RotFrame_u = .false. ! every input is on a mesh, which stores values in the global (not rotating) frame - - idx = 1 - call PackMotionMesh_Names(u%CoupledKinematics(1), 'CoupledKinematics', InitOut%LinNames_u, idx) ! all 6 motion fields - - ! --- Jac_u_indx: matrix to store index to help us figure out what the ith value of the u vector really means - ! (see perturb_u ... these MUST match ) - ! column 1 indicates module's mesh and field - ! column 2 indicates the first index (x-y-z component) of the field - ! column 3 is the node - call allocAry( p%Jac_u_indx, nu, 3, 'p%Jac_u_indx', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return - p%Jac_u_indx = 0 ! initialize to zero - idx = 1 - !Module/Mesh/Field: u%CoupledKinematics(1)%TranslationDisp = 1; - !Module/Mesh/Field: u%CoupledKinematics(1)%Orientation = 2; - !Module/Mesh/Field: u%CoupledKinematics(1)%TranslationVel = 3; - !Module/Mesh/Field: u%CoupledKinematics(1)%RotationVel = 4; - !Module/Mesh/Field: u%CoupledKinematics(1)%TranslationAcc = 5; - !Module/Mesh/Field: u%CoupledKinematics(1)%RotationAcc = 6; - do i_meshField = 1,6 - do i=1,u%CoupledKinematics(1)%nNodes - do j=1,3 - p%Jac_u_indx(idx,1) = i_meshField ! mesh field type (indicated by 1-6) - p%Jac_u_indx(idx,2) = j ! x, y, or z - p%Jac_u_indx(idx,3) = i ! node - idx = idx + 1 - end do !j - end do !i - end do - ! now do the active tensioning commands if there are any - if (allocated(u%DeltaL)) then - do i=1,size(u%DeltaL) ! Signals may be passed in without being requested for control - ! Figure out if this DeltaL control channel is associated with a line or multiple or none and label - LinCtrl = .FALSE. - LinStr = '(lines: ' - do J=1,p%NLines - if (m%LineList(J)%CtrlChan == i) then - LinCtrl = .TRUE. - LinStr = LinStr//trim(num2lstr(i))//' ' - endif - enddo - if ( LinCtrl) LinStr = LinStr//' )' - if (.not. LinCtrl) LinStr = '(lines: none)' - - p%Jac_u_indx(idx,1) = 10 ! 10-11 mean active tension changes (10: deltaL; 11: deltaLdot) - p%Jac_u_indx(idx,2) = 0 ! not used - p%Jac_u_indx(idx,3) = i ! indicates DeltaL entry number - InitOut%LinNames_u(idx) = 'CtrlChan DeltaL '//trim(num2lstr(i))//', m '//trim(LinStr) - idx = idx + 1 - - p%Jac_u_indx(idx,1) = 11 - p%Jac_u_indx(idx,2) = 0 - p%Jac_u_indx(idx,3) = i - InitOut%LinNames_u(idx) = 'CtrlChan DeltaLdot '//trim(num2lstr(i))//', m/s'//trim(LinStr) - idx = idx + 1 - end do - endif - - ! --- Default perturbations, p%du: - call allocAry( p%du, 11, 'p%du', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return - p%du( 1) = dl_slack_min ! u%CoupledKinematics(1)%TranslationDisp = 1; - p%du( 2) = 0.1_ReKi ! u%CoupledKinematics(1)%Orientation = 2; - p%du( 3) = 0.1_ReKi ! u%CoupledKinematics(1)%TranslationVel = 3; - p%du( 4) = 0.1_ReKi ! u%CoupledKinematics(1)%RotationVel = 4; - p%du( 5) = 0.1_ReKi ! u%CoupledKinematics(1)%TranslationAcc = 5; - p%du( 6) = 0.1_ReKi ! u%CoupledKinematics(1)%RotationAcc = 6; - p%du(10) = dl_slack_min ! deltaL [m] - p%du(11) = 0.2_ReKi ! deltaLdot [m/s] - END SUBROUTINE Init_Jacobian_u - -END SUBROUTINE MD_Init_Jacobian -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine MD_init_jacobian is consistant with this routine! -SUBROUTINE MD_Perturb_u( p, n, perturb_sign, u, du ) - TYPE(MD_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(MD_InputType) , INTENT(INOUT) :: u !< perturbed MD inputs - REAL( R8Ki ) , INTENT( OUT) :: du !< amount that specific input was perturbed - ! local variables - INTEGER :: fieldIndx - INTEGER :: node - fieldIndx = p%Jac_u_indx(n,2) - node = p%Jac_u_indx(n,3) - du = p%du( p%Jac_u_indx(n,1) ) - ! determine which mesh we're trying to perturb and perturb the input: - SELECT CASE( p%Jac_u_indx(n,1) ) - CASE ( 1) - u%CoupledKinematics(1)%TranslationDisp( fieldIndx,node) = u%CoupledKinematics(1)%TranslationDisp( fieldIndx,node) + du * perturb_sign - CASE ( 2) - CALL PerturbOrientationMatrix( u%CoupledKinematics(1)%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.false. ) - CASE ( 3) - u%CoupledKinematics(1)%TranslationVel( fieldIndx,node) = u%CoupledKinematics(1)%TranslationVel( fieldIndx,node) + du * perturb_sign - CASE ( 4) - u%CoupledKinematics(1)%RotationVel(fieldIndx,node) = u%CoupledKinematics(1)%RotationVel(fieldIndx,node) + du * perturb_sign - CASE ( 5) - u%CoupledKinematics(1)%TranslationAcc( fieldIndx,node) = u%CoupledKinematics(1)%TranslationAcc( fieldIndx,node) + du * perturb_sign - CASE ( 6) - u%CoupledKinematics(1)%RotationAcc(fieldIndx,node) = u%CoupledKinematics(1)%RotationAcc(fieldIndx,node) + du * perturb_sign - CASE (10) - u%deltaL(node) = u%deltaL(node) + du * perturb_sign - CASE (11) - u%deltaLdot(node) = u%deltaLdot(node) + du * perturb_sign - END SELECT -END SUBROUTINE MD_Perturb_u -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine MD_init_jacobian is consistant with this routine! -SUBROUTINE MD_Compute_dY(p, y_p, y_m, delta, dY) - TYPE(MD_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(MD_OutputType) , INTENT(IN ) :: y_p !< MD outputs at \f$ u + \Delta_p u \f$ or \f$ z + \Delta_p z \f$ (p=plus) - TYPE(MD_OutputType) , INTENT(IN ) :: y_m !< MD outputs at \f$ u - \Delta_m u \f$ or \f$ z - \Delta_m z \f$ (m=minus) - REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta_p = \Delta_p u \f$ or \f$ delta_p = \Delta_p x \f$ - REAL(R8Ki) , INTENT(INOUT) :: dY(:) !< column of dYdu or dYdx: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial z_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ - ! local variables: - INTEGER(IntKi) :: i ! loop over outputs - INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled - indx_first = 1 - call PackLoadMesh_dY( y_p%CoupledLoads(1), y_m%CoupledLoads(1), dY, indx_first) - !call PackMotionMesh_dY(y_p%Y2Mesh, y_m%Y2Mesh, dY, indx_first) ! all 6 motion fields - do i=1,p%NumOuts - dY(i+indx_first-1) = y_p%WriteOutput(i) - y_m%WriteOutput(i) - end do - dY = dY / (2.0_R8Ki*delta) -END SUBROUTINE MD_Compute_dY -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the x array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine MD_init_jacobian is consistant with this routine! -SUBROUTINE MD_Perturb_x( p, i, perturb_sign, x, dx ) - TYPE(MD_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: i !< state array index number - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(MD_ContinuousStateType), INTENT(INOUT) :: x !< perturbed MD states - REAL( R8Ki ) , INTENT( OUT) :: dx !< amount that specific state was perturbed - integer(IntKi) :: j - dx = p%dx(i) - j = p%dxIdx_map2_xStateIdx(i) - x%states(j) = x%states(j) + dx * perturb_sign -END SUBROUTINE MD_Perturb_x -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine MD_init_jacobian is consistant with this routine! -SUBROUTINE MD_Compute_dX(p, x_p, x_m, delta, dX) - TYPE(MD_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(MD_ContinuousStateType), INTENT(IN ) :: x_p !< = AbortErrLev) return end subroutine subroutine MD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -2592,6 +2613,8 @@ subroutine MD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%DerivOrder_x)) then deallocate(InitOutputData%DerivOrder_x) end if + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine MD_PackInitOutput(RF, Indata) @@ -2611,6 +2634,7 @@ subroutine MD_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%RotFrame_u) call RegPackAlloc(RF, InData%IsLoad_u) call RegPackAlloc(RF, InData%DerivOrder_x) + call NWTC_Library_PackModVarsType(RF, InData%Vars) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -2634,6 +2658,7 @@ subroutine MD_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end subroutine subroutine MD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -2807,1839 +2832,1874 @@ subroutine MD_UnPackOtherState(RF, OutData) call RegUnpack(RF, OutData%dummy); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(MD_MiscVarType), intent(in) :: SrcMiscData - type(MD_MiscVarType), intent(inout) :: DstMiscData +subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(MD_ParameterType), intent(in) :: SrcParamData + type(MD_ParameterType), intent(inout) :: DstParamData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'MD_CopyMisc' + character(*), parameter :: RoutineName = 'MD_CopyParam' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcMiscData%LineTypeList)) then - LB(1:1) = lbound(SrcMiscData%LineTypeList) - UB(1:1) = ubound(SrcMiscData%LineTypeList) - if (.not. allocated(DstMiscData%LineTypeList)) then - allocate(DstMiscData%LineTypeList(LB(1):UB(1)), stat=ErrStat2) + DstParamData%nLineTypes = SrcParamData%nLineTypes + DstParamData%nRodTypes = SrcParamData%nRodTypes + DstParamData%nPoints = SrcParamData%nPoints + DstParamData%nPointsExtra = SrcParamData%nPointsExtra + DstParamData%nBodies = SrcParamData%nBodies + DstParamData%nRods = SrcParamData%nRods + DstParamData%nLines = SrcParamData%nLines + DstParamData%nCtrlChans = SrcParamData%nCtrlChans + DstParamData%nFails = SrcParamData%nFails + DstParamData%nFreeBodies = SrcParamData%nFreeBodies + DstParamData%nFreeRods = SrcParamData%nFreeRods + DstParamData%nFreePoints = SrcParamData%nFreePoints + if (allocated(SrcParamData%nCpldBodies)) then + LB(1:1) = lbound(SrcParamData%nCpldBodies) + UB(1:1) = ubound(SrcParamData%nCpldBodies) + if (.not. allocated(DstParamData%nCpldBodies)) then + allocate(DstParamData%nCpldBodies(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineTypeList.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldBodies.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MD_CopyLineProp(SrcMiscData%LineTypeList(i1), DstMiscData%LineTypeList(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%nCpldBodies = SrcParamData%nCpldBodies end if - if (allocated(SrcMiscData%RodTypeList)) then - LB(1:1) = lbound(SrcMiscData%RodTypeList) - UB(1:1) = ubound(SrcMiscData%RodTypeList) - if (.not. allocated(DstMiscData%RodTypeList)) then - allocate(DstMiscData%RodTypeList(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%nCpldRods)) then + LB(1:1) = lbound(SrcParamData%nCpldRods) + UB(1:1) = ubound(SrcParamData%nCpldRods) + if (.not. allocated(DstParamData%nCpldRods)) then + allocate(DstParamData%nCpldRods(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodTypeList.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldRods.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MD_CopyRodProp(SrcMiscData%RodTypeList(i1), DstMiscData%RodTypeList(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%nCpldRods = SrcParamData%nCpldRods end if - call MD_CopyBody(SrcMiscData%GroundBody, DstMiscData%GroundBody, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcMiscData%BodyList)) then - LB(1:1) = lbound(SrcMiscData%BodyList) - UB(1:1) = ubound(SrcMiscData%BodyList) - if (.not. allocated(DstMiscData%BodyList)) then - allocate(DstMiscData%BodyList(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%nCpldPoints)) then + LB(1:1) = lbound(SrcParamData%nCpldPoints) + UB(1:1) = ubound(SrcParamData%nCpldPoints) + if (.not. allocated(DstParamData%nCpldPoints)) then + allocate(DstParamData%nCpldPoints(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyList.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldPoints.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MD_CopyBody(SrcMiscData%BodyList(i1), DstMiscData%BodyList(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%nCpldPoints = SrcParamData%nCpldPoints end if - if (allocated(SrcMiscData%RodList)) then - LB(1:1) = lbound(SrcMiscData%RodList) - UB(1:1) = ubound(SrcMiscData%RodList) - if (.not. allocated(DstMiscData%RodList)) then - allocate(DstMiscData%RodList(LB(1):UB(1)), stat=ErrStat2) + DstParamData%NConns = SrcParamData%NConns + DstParamData%NAnchs = SrcParamData%NAnchs + DstParamData%Tmax = SrcParamData%Tmax + DstParamData%g = SrcParamData%g + DstParamData%rhoW = SrcParamData%rhoW + DstParamData%WtrDpth = SrcParamData%WtrDpth + DstParamData%kBot = SrcParamData%kBot + DstParamData%cBot = SrcParamData%cBot + DstParamData%dtM0 = SrcParamData%dtM0 + DstParamData%dtCoupling = SrcParamData%dtCoupling + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%dtOut = SrcParamData%dtOut + DstParamData%RootName = SrcParamData%RootName + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodList.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MD_CopyRod(SrcMiscData%RodList(i1), DstMiscData%RodList(i1), CtrlCode, ErrStat2, ErrMsg2) + call MD_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcMiscData%PointList)) then - LB(1:1) = lbound(SrcMiscData%PointList) - UB(1:1) = ubound(SrcMiscData%PointList) - if (.not. allocated(DstMiscData%PointList)) then - allocate(DstMiscData%PointList(LB(1):UB(1)), stat=ErrStat2) + DstParamData%Delim = SrcParamData%Delim + DstParamData%MDUnOut = SrcParamData%MDUnOut + DstParamData%PriPath = SrcParamData%PriPath + DstParamData%writeLog = SrcParamData%writeLog + DstParamData%UnLog = SrcParamData%UnLog + DstParamData%WaveKin = SrcParamData%WaveKin + DstParamData%Current = SrcParamData%Current + DstParamData%nTurbines = SrcParamData%nTurbines + if (allocated(SrcParamData%TurbineRefPos)) then + LB(1:2) = lbound(SrcParamData%TurbineRefPos) + UB(1:2) = ubound(SrcParamData%TurbineRefPos) + if (.not. allocated(DstParamData%TurbineRefPos)) then + allocate(DstParamData%TurbineRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointList.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TurbineRefPos.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MD_CopyPoint(SrcMiscData%PointList(i1), DstMiscData%PointList(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%TurbineRefPos = SrcParamData%TurbineRefPos end if - if (allocated(SrcMiscData%LineList)) then - LB(1:1) = lbound(SrcMiscData%LineList) - UB(1:1) = ubound(SrcMiscData%LineList) - if (.not. allocated(DstMiscData%LineList)) then - allocate(DstMiscData%LineList(LB(1):UB(1)), stat=ErrStat2) + DstParamData%mu_kT = SrcParamData%mu_kT + DstParamData%mu_kA = SrcParamData%mu_kA + DstParamData%mc = SrcParamData%mc + DstParamData%cv = SrcParamData%cv + DstParamData%inertialF = SrcParamData%inertialF + DstParamData%inertialF_rampT = SrcParamData%inertialF_rampT + DstParamData%nxWave = SrcParamData%nxWave + DstParamData%nyWave = SrcParamData%nyWave + DstParamData%nzWave = SrcParamData%nzWave + DstParamData%ntWave = SrcParamData%ntWave + if (allocated(SrcParamData%pxWave)) then + LB(1:1) = lbound(SrcParamData%pxWave) + UB(1:1) = ubound(SrcParamData%pxWave) + if (.not. allocated(DstParamData%pxWave)) then + allocate(DstParamData%pxWave(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineList.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pxWave.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MD_CopyLine(SrcMiscData%LineList(i1), DstMiscData%LineList(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%pxWave = SrcParamData%pxWave end if - if (allocated(SrcMiscData%FailList)) then - LB(1:1) = lbound(SrcMiscData%FailList) - UB(1:1) = ubound(SrcMiscData%FailList) - if (.not. allocated(DstMiscData%FailList)) then - allocate(DstMiscData%FailList(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%pyWave)) then + LB(1:1) = lbound(SrcParamData%pyWave) + UB(1:1) = ubound(SrcParamData%pyWave) + if (.not. allocated(DstParamData%pyWave)) then + allocate(DstParamData%pyWave(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FailList.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pyWave.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MD_CopyFail(SrcMiscData%FailList(i1), DstMiscData%FailList(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%pyWave = SrcParamData%pyWave end if - if (allocated(SrcMiscData%FreePointIs)) then - LB(1:1) = lbound(SrcMiscData%FreePointIs) - UB(1:1) = ubound(SrcMiscData%FreePointIs) - if (.not. allocated(DstMiscData%FreePointIs)) then - allocate(DstMiscData%FreePointIs(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%pzWave)) then + LB(1:1) = lbound(SrcParamData%pzWave) + UB(1:1) = ubound(SrcParamData%pzWave) + if (.not. allocated(DstParamData%pzWave)) then + allocate(DstParamData%pzWave(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreePointIs.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzWave.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%FreePointIs = SrcMiscData%FreePointIs + DstParamData%pzWave = SrcParamData%pzWave end if - if (allocated(SrcMiscData%CpldPointIs)) then - LB(1:2) = lbound(SrcMiscData%CpldPointIs) - UB(1:2) = ubound(SrcMiscData%CpldPointIs) - if (.not. allocated(DstMiscData%CpldPointIs)) then - allocate(DstMiscData%CpldPointIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + DstParamData%dtWave = SrcParamData%dtWave + if (allocated(SrcParamData%uxWave)) then + LB(1:4) = lbound(SrcParamData%uxWave) + UB(1:4) = ubound(SrcParamData%uxWave) + if (.not. allocated(DstParamData%uxWave)) then + allocate(DstParamData%uxWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldPointIs.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uxWave.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%CpldPointIs = SrcMiscData%CpldPointIs + DstParamData%uxWave = SrcParamData%uxWave end if - if (allocated(SrcMiscData%FreeRodIs)) then - LB(1:1) = lbound(SrcMiscData%FreeRodIs) - UB(1:1) = ubound(SrcMiscData%FreeRodIs) - if (.not. allocated(DstMiscData%FreeRodIs)) then - allocate(DstMiscData%FreeRodIs(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%uyWave)) then + LB(1:4) = lbound(SrcParamData%uyWave) + UB(1:4) = ubound(SrcParamData%uyWave) + if (.not. allocated(DstParamData%uyWave)) then + allocate(DstParamData%uyWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeRodIs.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyWave.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%FreeRodIs = SrcMiscData%FreeRodIs + DstParamData%uyWave = SrcParamData%uyWave end if - if (allocated(SrcMiscData%CpldRodIs)) then - LB(1:2) = lbound(SrcMiscData%CpldRodIs) - UB(1:2) = ubound(SrcMiscData%CpldRodIs) - if (.not. allocated(DstMiscData%CpldRodIs)) then - allocate(DstMiscData%CpldRodIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%uzWave)) then + LB(1:4) = lbound(SrcParamData%uzWave) + UB(1:4) = ubound(SrcParamData%uzWave) + if (.not. allocated(DstParamData%uzWave)) then + allocate(DstParamData%uzWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldRodIs.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uzWave.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%CpldRodIs = SrcMiscData%CpldRodIs + DstParamData%uzWave = SrcParamData%uzWave end if - if (allocated(SrcMiscData%FreeBodyIs)) then - LB(1:1) = lbound(SrcMiscData%FreeBodyIs) - UB(1:1) = ubound(SrcMiscData%FreeBodyIs) - if (.not. allocated(DstMiscData%FreeBodyIs)) then - allocate(DstMiscData%FreeBodyIs(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%axWave)) then + LB(1:4) = lbound(SrcParamData%axWave) + UB(1:4) = ubound(SrcParamData%axWave) + if (.not. allocated(DstParamData%axWave)) then + allocate(DstParamData%axWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeBodyIs.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%axWave.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%FreeBodyIs = SrcMiscData%FreeBodyIs + DstParamData%axWave = SrcParamData%axWave end if - if (allocated(SrcMiscData%CpldBodyIs)) then - LB(1:2) = lbound(SrcMiscData%CpldBodyIs) - UB(1:2) = ubound(SrcMiscData%CpldBodyIs) - if (.not. allocated(DstMiscData%CpldBodyIs)) then - allocate(DstMiscData%CpldBodyIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%ayWave)) then + LB(1:4) = lbound(SrcParamData%ayWave) + UB(1:4) = ubound(SrcParamData%ayWave) + if (.not. allocated(DstParamData%ayWave)) then + allocate(DstParamData%ayWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldBodyIs.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ayWave.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%CpldBodyIs = SrcMiscData%CpldBodyIs + DstParamData%ayWave = SrcParamData%ayWave end if - if (allocated(SrcMiscData%LineStateIs1)) then - LB(1:1) = lbound(SrcMiscData%LineStateIs1) - UB(1:1) = ubound(SrcMiscData%LineStateIs1) - if (.not. allocated(DstMiscData%LineStateIs1)) then - allocate(DstMiscData%LineStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%azWave)) then + LB(1:4) = lbound(SrcParamData%azWave) + UB(1:4) = ubound(SrcParamData%azWave) + if (.not. allocated(DstParamData%azWave)) then + allocate(DstParamData%azWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIs1.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%azWave.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%LineStateIs1 = SrcMiscData%LineStateIs1 + DstParamData%azWave = SrcParamData%azWave end if - if (allocated(SrcMiscData%LineStateIsN)) then - LB(1:1) = lbound(SrcMiscData%LineStateIsN) - UB(1:1) = ubound(SrcMiscData%LineStateIsN) - if (.not. allocated(DstMiscData%LineStateIsN)) then - allocate(DstMiscData%LineStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%PDyn)) then + LB(1:4) = lbound(SrcParamData%PDyn) + UB(1:4) = ubound(SrcParamData%PDyn) + if (.not. allocated(DstParamData%PDyn)) then + allocate(DstParamData%PDyn(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIsN.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PDyn.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%LineStateIsN = SrcMiscData%LineStateIsN + DstParamData%PDyn = SrcParamData%PDyn end if - if (allocated(SrcMiscData%PointStateIs1)) then - LB(1:1) = lbound(SrcMiscData%PointStateIs1) - UB(1:1) = ubound(SrcMiscData%PointStateIs1) - if (.not. allocated(DstMiscData%PointStateIs1)) then - allocate(DstMiscData%PointStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%zeta)) then + LB(1:3) = lbound(SrcParamData%zeta) + UB(1:3) = ubound(SrcParamData%zeta) + if (.not. allocated(DstParamData%zeta)) then + allocate(DstParamData%zeta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointStateIs1.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%zeta.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%PointStateIs1 = SrcMiscData%PointStateIs1 + DstParamData%zeta = SrcParamData%zeta end if - if (allocated(SrcMiscData%PointStateIsN)) then - LB(1:1) = lbound(SrcMiscData%PointStateIsN) - UB(1:1) = ubound(SrcMiscData%PointStateIsN) - if (.not. allocated(DstMiscData%PointStateIsN)) then - allocate(DstMiscData%PointStateIsN(LB(1):UB(1)), stat=ErrStat2) + DstParamData%nzCurrent = SrcParamData%nzCurrent + if (allocated(SrcParamData%pzCurrent)) then + LB(1:1) = lbound(SrcParamData%pzCurrent) + UB(1:1) = ubound(SrcParamData%pzCurrent) + if (.not. allocated(DstParamData%pzCurrent)) then + allocate(DstParamData%pzCurrent(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointStateIsN.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzCurrent.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%PointStateIsN = SrcMiscData%PointStateIsN + DstParamData%pzCurrent = SrcParamData%pzCurrent end if - if (allocated(SrcMiscData%RodStateIs1)) then - LB(1:1) = lbound(SrcMiscData%RodStateIs1) - UB(1:1) = ubound(SrcMiscData%RodStateIs1) - if (.not. allocated(DstMiscData%RodStateIs1)) then - allocate(DstMiscData%RodStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%uxCurrent)) then + LB(1:1) = lbound(SrcParamData%uxCurrent) + UB(1:1) = ubound(SrcParamData%uxCurrent) + if (.not. allocated(DstParamData%uxCurrent)) then + allocate(DstParamData%uxCurrent(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIs1.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uxCurrent.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%RodStateIs1 = SrcMiscData%RodStateIs1 + DstParamData%uxCurrent = SrcParamData%uxCurrent end if - if (allocated(SrcMiscData%RodStateIsN)) then - LB(1:1) = lbound(SrcMiscData%RodStateIsN) - UB(1:1) = ubound(SrcMiscData%RodStateIsN) - if (.not. allocated(DstMiscData%RodStateIsN)) then - allocate(DstMiscData%RodStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%uyCurrent)) then + LB(1:1) = lbound(SrcParamData%uyCurrent) + UB(1:1) = ubound(SrcParamData%uyCurrent) + if (.not. allocated(DstParamData%uyCurrent)) then + allocate(DstParamData%uyCurrent(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIsN.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyCurrent.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%RodStateIsN = SrcMiscData%RodStateIsN + DstParamData%uyCurrent = SrcParamData%uyCurrent end if - if (allocated(SrcMiscData%BodyStateIs1)) then - LB(1:1) = lbound(SrcMiscData%BodyStateIs1) - UB(1:1) = ubound(SrcMiscData%BodyStateIs1) - if (.not. allocated(DstMiscData%BodyStateIs1)) then - allocate(DstMiscData%BodyStateIs1(LB(1):UB(1)), stat=ErrStat2) + DstParamData%Nx0 = SrcParamData%Nx0 + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIs1.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%BodyStateIs1 = SrcMiscData%BodyStateIs1 + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx end if - if (allocated(SrcMiscData%BodyStateIsN)) then - LB(1:1) = lbound(SrcMiscData%BodyStateIsN) - UB(1:1) = ubound(SrcMiscData%BodyStateIsN) - if (.not. allocated(DstMiscData%BodyStateIsN)) then - allocate(DstMiscData%BodyStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIsN.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%BodyStateIsN = SrcMiscData%BodyStateIsN + DstParamData%du = SrcParamData%du end if - DstMiscData%Nx = SrcMiscData%Nx - DstMiscData%Nxtra = SrcMiscData%Nxtra - DstMiscData%WaveTi = SrcMiscData%WaveTi - call MD_CopyContState(SrcMiscData%xTemp, DstMiscData%xTemp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MD_CopyContState(SrcMiscData%xdTemp, DstMiscData%xdTemp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - DstMiscData%zeros6 = SrcMiscData%zeros6 - if (allocated(SrcMiscData%MDWrOutput)) then - LB(1:1) = lbound(SrcMiscData%MDWrOutput) - UB(1:1) = ubound(SrcMiscData%MDWrOutput) - if (.not. allocated(DstMiscData%MDWrOutput)) then - allocate(DstMiscData%MDWrOutput(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%dx)) then + LB(1:1) = lbound(SrcParamData%dx) + UB(1:1) = ubound(SrcParamData%dx) + if (.not. allocated(DstParamData%dx)) then + allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MDWrOutput.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%MDWrOutput = SrcMiscData%MDWrOutput + DstParamData%dx = SrcParamData%dx end if - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - DstMiscData%PtfmInit = SrcMiscData%PtfmInit - if (allocated(SrcMiscData%BathymetryGrid)) then - LB(1:2) = lbound(SrcMiscData%BathymetryGrid) - UB(1:2) = ubound(SrcMiscData%BathymetryGrid) - if (.not. allocated(DstMiscData%BathymetryGrid)) then - allocate(DstMiscData%BathymetryGrid(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%Jac_nx = SrcParamData%Jac_nx + if (allocated(SrcParamData%dxIdx_map2_xStateIdx)) then + LB(1:1) = lbound(SrcParamData%dxIdx_map2_xStateIdx) + UB(1:1) = ubound(SrcParamData%dxIdx_map2_xStateIdx) + if (.not. allocated(DstParamData%dxIdx_map2_xStateIdx)) then + allocate(DstParamData%dxIdx_map2_xStateIdx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathymetryGrid.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dxIdx_map2_xStateIdx.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%BathymetryGrid = SrcMiscData%BathymetryGrid + DstParamData%dxIdx_map2_xStateIdx = SrcParamData%dxIdx_map2_xStateIdx end if - if (allocated(SrcMiscData%BathGrid_Xs)) then - LB(1:1) = lbound(SrcMiscData%BathGrid_Xs) - UB(1:1) = ubound(SrcMiscData%BathGrid_Xs) - if (.not. allocated(DstMiscData%BathGrid_Xs)) then - allocate(DstMiscData%BathGrid_Xs(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Xs.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%BathGrid_Xs = SrcMiscData%BathGrid_Xs - end if - if (allocated(SrcMiscData%BathGrid_Ys)) then - LB(1:1) = lbound(SrcMiscData%BathGrid_Ys) - UB(1:1) = ubound(SrcMiscData%BathGrid_Ys) - if (.not. allocated(DstMiscData%BathGrid_Ys)) then - allocate(DstMiscData%BathGrid_Ys(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Ys.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%BathGrid_Ys = SrcMiscData%BathGrid_Ys - end if - if (allocated(SrcMiscData%BathGrid_npoints)) then - LB(1:1) = lbound(SrcMiscData%BathGrid_npoints) - UB(1:1) = ubound(SrcMiscData%BathGrid_npoints) - if (.not. allocated(DstMiscData%BathGrid_npoints)) then - allocate(DstMiscData%BathGrid_npoints(LB(1):UB(1)), stat=ErrStat2) + DstParamData%VisMeshes = SrcParamData%VisMeshes + if (allocated(SrcParamData%VisRodsDiam)) then + LB(1:1) = lbound(SrcParamData%VisRodsDiam) + UB(1:1) = ubound(SrcParamData%VisRodsDiam) + if (.not. allocated(DstParamData%VisRodsDiam)) then + allocate(DstParamData%VisRodsDiam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_npoints.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%VisRodsDiam.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%BathGrid_npoints = SrcMiscData%BathGrid_npoints + do i1 = LB(1), UB(1) + call MD_CopyVisDiam(SrcParamData%VisRodsDiam(i1), DstParamData%VisRodsDiam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if end subroutine -subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(MD_MiscVarType), intent(inout) :: MiscData +subroutine MD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(MD_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'MD_DestroyMisc' + character(*), parameter :: RoutineName = 'MD_DestroyParam' ErrStat = ErrID_None ErrMsg = '' - if (allocated(MiscData%LineTypeList)) then - LB(1:1) = lbound(MiscData%LineTypeList) - UB(1:1) = ubound(MiscData%LineTypeList) - do i1 = LB(1), UB(1) - call MD_DestroyLineProp(MiscData%LineTypeList(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%LineTypeList) - end if - if (allocated(MiscData%RodTypeList)) then - LB(1:1) = lbound(MiscData%RodTypeList) - UB(1:1) = ubound(MiscData%RodTypeList) - do i1 = LB(1), UB(1) - call MD_DestroyRodProp(MiscData%RodTypeList(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%RodTypeList) - end if - call MD_DestroyBody(MiscData%GroundBody, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(MiscData%BodyList)) then - LB(1:1) = lbound(MiscData%BodyList) - UB(1:1) = ubound(MiscData%BodyList) - do i1 = LB(1), UB(1) - call MD_DestroyBody(MiscData%BodyList(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%BodyList) + if (allocated(ParamData%nCpldBodies)) then + deallocate(ParamData%nCpldBodies) end if - if (allocated(MiscData%RodList)) then - LB(1:1) = lbound(MiscData%RodList) - UB(1:1) = ubound(MiscData%RodList) - do i1 = LB(1), UB(1) - call MD_DestroyRod(MiscData%RodList(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%RodList) + if (allocated(ParamData%nCpldRods)) then + deallocate(ParamData%nCpldRods) end if - if (allocated(MiscData%PointList)) then - LB(1:1) = lbound(MiscData%PointList) - UB(1:1) = ubound(MiscData%PointList) - do i1 = LB(1), UB(1) - call MD_DestroyPoint(MiscData%PointList(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%PointList) + if (allocated(ParamData%nCpldPoints)) then + deallocate(ParamData%nCpldPoints) end if - if (allocated(MiscData%LineList)) then - LB(1:1) = lbound(MiscData%LineList) - UB(1:1) = ubound(MiscData%LineList) + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) do i1 = LB(1), UB(1) - call MD_DestroyLine(MiscData%LineList(i1), ErrStat2, ErrMsg2) + call MD_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%LineList) + deallocate(ParamData%OutParam) end if - if (allocated(MiscData%FailList)) then - LB(1:1) = lbound(MiscData%FailList) - UB(1:1) = ubound(MiscData%FailList) - do i1 = LB(1), UB(1) - call MD_DestroyFail(MiscData%FailList(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%FailList) + if (allocated(ParamData%TurbineRefPos)) then + deallocate(ParamData%TurbineRefPos) end if - if (allocated(MiscData%FreePointIs)) then - deallocate(MiscData%FreePointIs) + if (allocated(ParamData%pxWave)) then + deallocate(ParamData%pxWave) end if - if (allocated(MiscData%CpldPointIs)) then - deallocate(MiscData%CpldPointIs) + if (allocated(ParamData%pyWave)) then + deallocate(ParamData%pyWave) end if - if (allocated(MiscData%FreeRodIs)) then - deallocate(MiscData%FreeRodIs) + if (allocated(ParamData%pzWave)) then + deallocate(ParamData%pzWave) end if - if (allocated(MiscData%CpldRodIs)) then - deallocate(MiscData%CpldRodIs) + if (allocated(ParamData%uxWave)) then + deallocate(ParamData%uxWave) end if - if (allocated(MiscData%FreeBodyIs)) then - deallocate(MiscData%FreeBodyIs) + if (allocated(ParamData%uyWave)) then + deallocate(ParamData%uyWave) end if - if (allocated(MiscData%CpldBodyIs)) then - deallocate(MiscData%CpldBodyIs) + if (allocated(ParamData%uzWave)) then + deallocate(ParamData%uzWave) end if - if (allocated(MiscData%LineStateIs1)) then - deallocate(MiscData%LineStateIs1) + if (allocated(ParamData%axWave)) then + deallocate(ParamData%axWave) end if - if (allocated(MiscData%LineStateIsN)) then - deallocate(MiscData%LineStateIsN) + if (allocated(ParamData%ayWave)) then + deallocate(ParamData%ayWave) end if - if (allocated(MiscData%PointStateIs1)) then - deallocate(MiscData%PointStateIs1) + if (allocated(ParamData%azWave)) then + deallocate(ParamData%azWave) end if - if (allocated(MiscData%PointStateIsN)) then - deallocate(MiscData%PointStateIsN) + if (allocated(ParamData%PDyn)) then + deallocate(ParamData%PDyn) end if - if (allocated(MiscData%RodStateIs1)) then - deallocate(MiscData%RodStateIs1) + if (allocated(ParamData%zeta)) then + deallocate(ParamData%zeta) end if - if (allocated(MiscData%RodStateIsN)) then - deallocate(MiscData%RodStateIsN) + if (allocated(ParamData%pzCurrent)) then + deallocate(ParamData%pzCurrent) end if - if (allocated(MiscData%BodyStateIs1)) then - deallocate(MiscData%BodyStateIs1) + if (allocated(ParamData%uxCurrent)) then + deallocate(ParamData%uxCurrent) end if - if (allocated(MiscData%BodyStateIsN)) then - deallocate(MiscData%BodyStateIsN) + if (allocated(ParamData%uyCurrent)) then + deallocate(ParamData%uyCurrent) end if - call MD_DestroyContState(MiscData%xTemp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MD_DestroyContState(MiscData%xdTemp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(MiscData%MDWrOutput)) then - deallocate(MiscData%MDWrOutput) + if (allocated(ParamData%Jac_u_indx)) then + deallocate(ParamData%Jac_u_indx) end if - if (allocated(MiscData%BathymetryGrid)) then - deallocate(MiscData%BathymetryGrid) + if (allocated(ParamData%du)) then + deallocate(ParamData%du) end if - if (allocated(MiscData%BathGrid_Xs)) then - deallocate(MiscData%BathGrid_Xs) + if (allocated(ParamData%dx)) then + deallocate(ParamData%dx) end if - if (allocated(MiscData%BathGrid_Ys)) then - deallocate(MiscData%BathGrid_Ys) + if (allocated(ParamData%dxIdx_map2_xStateIdx)) then + deallocate(ParamData%dxIdx_map2_xStateIdx) end if - if (allocated(MiscData%BathGrid_npoints)) then - deallocate(MiscData%BathGrid_npoints) + if (allocated(ParamData%VisRodsDiam)) then + LB(1:1) = lbound(ParamData%VisRodsDiam) + UB(1:1) = ubound(ParamData%VisRodsDiam) + do i1 = LB(1), UB(1) + call MD_DestroyVisDiam(ParamData%VisRodsDiam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%VisRodsDiam) end if end subroutine -subroutine MD_PackMisc(RF, Indata) +subroutine MD_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF - type(MD_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'MD_PackMisc' - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) + type(MD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackParam' + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%LineTypeList)) - if (allocated(InData%LineTypeList)) then - call RegPackBounds(RF, 1, lbound(InData%LineTypeList), ubound(InData%LineTypeList)) - LB(1:1) = lbound(InData%LineTypeList) - UB(1:1) = ubound(InData%LineTypeList) + call RegPack(RF, InData%nLineTypes) + call RegPack(RF, InData%nRodTypes) + call RegPack(RF, InData%nPoints) + call RegPack(RF, InData%nPointsExtra) + call RegPack(RF, InData%nBodies) + call RegPack(RF, InData%nRods) + call RegPack(RF, InData%nLines) + call RegPack(RF, InData%nCtrlChans) + call RegPack(RF, InData%nFails) + call RegPack(RF, InData%nFreeBodies) + call RegPack(RF, InData%nFreeRods) + call RegPack(RF, InData%nFreePoints) + call RegPackAlloc(RF, InData%nCpldBodies) + call RegPackAlloc(RF, InData%nCpldRods) + call RegPackAlloc(RF, InData%nCpldPoints) + call RegPack(RF, InData%NConns) + call RegPack(RF, InData%NAnchs) + call RegPack(RF, InData%Tmax) + call RegPack(RF, InData%g) + call RegPack(RF, InData%rhoW) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%kBot) + call RegPack(RF, InData%cBot) + call RegPack(RF, InData%dtM0) + call RegPack(RF, InData%dtCoupling) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%dtOut) + call RegPack(RF, InData%RootName) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) do i1 = LB(1), UB(1) - call MD_PackLineProp(RF, InData%LineTypeList(i1)) + call MD_PackOutParmType(RF, InData%OutParam(i1)) end do end if - call RegPack(RF, allocated(InData%RodTypeList)) - if (allocated(InData%RodTypeList)) then - call RegPackBounds(RF, 1, lbound(InData%RodTypeList), ubound(InData%RodTypeList)) - LB(1:1) = lbound(InData%RodTypeList) - UB(1:1) = ubound(InData%RodTypeList) - do i1 = LB(1), UB(1) - call MD_PackRodProp(RF, InData%RodTypeList(i1)) - end do - end if - call MD_PackBody(RF, InData%GroundBody) - call RegPack(RF, allocated(InData%BodyList)) - if (allocated(InData%BodyList)) then - call RegPackBounds(RF, 1, lbound(InData%BodyList), ubound(InData%BodyList)) - LB(1:1) = lbound(InData%BodyList) - UB(1:1) = ubound(InData%BodyList) - do i1 = LB(1), UB(1) - call MD_PackBody(RF, InData%BodyList(i1)) - end do - end if - call RegPack(RF, allocated(InData%RodList)) - if (allocated(InData%RodList)) then - call RegPackBounds(RF, 1, lbound(InData%RodList), ubound(InData%RodList)) - LB(1:1) = lbound(InData%RodList) - UB(1:1) = ubound(InData%RodList) - do i1 = LB(1), UB(1) - call MD_PackRod(RF, InData%RodList(i1)) - end do - end if - call RegPack(RF, allocated(InData%PointList)) - if (allocated(InData%PointList)) then - call RegPackBounds(RF, 1, lbound(InData%PointList), ubound(InData%PointList)) - LB(1:1) = lbound(InData%PointList) - UB(1:1) = ubound(InData%PointList) - do i1 = LB(1), UB(1) - call MD_PackPoint(RF, InData%PointList(i1)) - end do - end if - call RegPack(RF, allocated(InData%LineList)) - if (allocated(InData%LineList)) then - call RegPackBounds(RF, 1, lbound(InData%LineList), ubound(InData%LineList)) - LB(1:1) = lbound(InData%LineList) - UB(1:1) = ubound(InData%LineList) - do i1 = LB(1), UB(1) - call MD_PackLine(RF, InData%LineList(i1)) - end do - end if - call RegPack(RF, allocated(InData%FailList)) - if (allocated(InData%FailList)) then - call RegPackBounds(RF, 1, lbound(InData%FailList), ubound(InData%FailList)) - LB(1:1) = lbound(InData%FailList) - UB(1:1) = ubound(InData%FailList) + call RegPack(RF, InData%Delim) + call RegPack(RF, InData%MDUnOut) + call RegPack(RF, InData%PriPath) + call RegPack(RF, InData%writeLog) + call RegPack(RF, InData%UnLog) + call RegPack(RF, InData%WaveKin) + call RegPack(RF, InData%Current) + call RegPack(RF, InData%nTurbines) + call RegPackAlloc(RF, InData%TurbineRefPos) + call RegPack(RF, InData%mu_kT) + call RegPack(RF, InData%mu_kA) + call RegPack(RF, InData%mc) + call RegPack(RF, InData%cv) + call RegPack(RF, InData%inertialF) + call RegPack(RF, InData%inertialF_rampT) + call RegPack(RF, InData%nxWave) + call RegPack(RF, InData%nyWave) + call RegPack(RF, InData%nzWave) + call RegPack(RF, InData%ntWave) + call RegPackAlloc(RF, InData%pxWave) + call RegPackAlloc(RF, InData%pyWave) + call RegPackAlloc(RF, InData%pzWave) + call RegPack(RF, InData%dtWave) + call RegPackAlloc(RF, InData%uxWave) + call RegPackAlloc(RF, InData%uyWave) + call RegPackAlloc(RF, InData%uzWave) + call RegPackAlloc(RF, InData%axWave) + call RegPackAlloc(RF, InData%ayWave) + call RegPackAlloc(RF, InData%azWave) + call RegPackAlloc(RF, InData%PDyn) + call RegPackAlloc(RF, InData%zeta) + call RegPack(RF, InData%nzCurrent) + call RegPackAlloc(RF, InData%pzCurrent) + call RegPackAlloc(RF, InData%uxCurrent) + call RegPackAlloc(RF, InData%uyCurrent) + call RegPack(RF, InData%Nx0) + call RegPackAlloc(RF, InData%Jac_u_indx) + call RegPackAlloc(RF, InData%du) + call RegPackAlloc(RF, InData%dx) + call RegPack(RF, InData%Jac_ny) + call RegPack(RF, InData%Jac_nx) + call RegPackAlloc(RF, InData%dxIdx_map2_xStateIdx) + call RegPack(RF, InData%VisMeshes) + call RegPack(RF, allocated(InData%VisRodsDiam)) + if (allocated(InData%VisRodsDiam)) then + call RegPackBounds(RF, 1, lbound(InData%VisRodsDiam), ubound(InData%VisRodsDiam)) + LB(1:1) = lbound(InData%VisRodsDiam) + UB(1:1) = ubound(InData%VisRodsDiam) do i1 = LB(1), UB(1) - call MD_PackFail(RF, InData%FailList(i1)) + call MD_PackVisDiam(RF, InData%VisRodsDiam(i1)) end do end if - call RegPackAlloc(RF, InData%FreePointIs) - call RegPackAlloc(RF, InData%CpldPointIs) - call RegPackAlloc(RF, InData%FreeRodIs) - call RegPackAlloc(RF, InData%CpldRodIs) - call RegPackAlloc(RF, InData%FreeBodyIs) - call RegPackAlloc(RF, InData%CpldBodyIs) - call RegPackAlloc(RF, InData%LineStateIs1) - call RegPackAlloc(RF, InData%LineStateIsN) - call RegPackAlloc(RF, InData%PointStateIs1) - call RegPackAlloc(RF, InData%PointStateIsN) - call RegPackAlloc(RF, InData%RodStateIs1) - call RegPackAlloc(RF, InData%RodStateIsN) - call RegPackAlloc(RF, InData%BodyStateIs1) - call RegPackAlloc(RF, InData%BodyStateIsN) - call RegPack(RF, InData%Nx) - call RegPack(RF, InData%Nxtra) - call RegPack(RF, InData%WaveTi) - call MD_PackContState(RF, InData%xTemp) - call MD_PackContState(RF, InData%xdTemp) - call RegPack(RF, InData%zeros6) - call RegPackAlloc(RF, InData%MDWrOutput) - call RegPack(RF, InData%LastOutTime) - call RegPack(RF, InData%PtfmInit) - call RegPackAlloc(RF, InData%BathymetryGrid) - call RegPackAlloc(RF, InData%BathGrid_Xs) - call RegPackAlloc(RF, InData%BathGrid_Ys) - call RegPackAlloc(RF, InData%BathGrid_npoints) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackMisc(RF, OutData) +subroutine MD_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF - type(MD_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'MD_UnPackMisc' - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) + type(MD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackParam' + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%LineTypeList)) deallocate(OutData%LineTypeList) + call RegUnpack(RF, OutData%nLineTypes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nRodTypes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nPoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nPointsExtra); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nBodies); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nRods); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nLines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nCtrlChans); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFails); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFreeBodies); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFreeRods); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFreePoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%nCpldBodies); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%nCpldRods); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%nCpldPoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NConns); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NAnchs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tmax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%g); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rhoW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%kBot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%cBot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dtM0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dtCoupling); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dtOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%LineTypeList(LB(1):UB(1)),stat=stat) + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineTypeList.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackLineProp(RF, OutData%LineTypeList(i1)) ! LineTypeList + call MD_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam end do end if - if (allocated(OutData%RodTypeList)) deallocate(OutData%RodTypeList) + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MDUnOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PriPath); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%writeLog); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnLog); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveKin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Current); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nTurbines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TurbineRefPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%mu_kT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%mu_kA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%mc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%cv); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%inertialF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%inertialF_rampT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nxWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nyWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nzWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ntWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%pxWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%pyWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%pzWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dtWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uxWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uyWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uzWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%axWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ayWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%azWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PDyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%zeta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nzCurrent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%pzCurrent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uxCurrent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uyCurrent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nx0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dxIdx_map2_xStateIdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VisMeshes); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%VisRodsDiam)) deallocate(OutData%VisRodsDiam) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%RodTypeList(LB(1):UB(1)),stat=stat) + allocate(OutData%VisRodsDiam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodTypeList.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisRodsDiam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackRodProp(RF, OutData%RodTypeList(i1)) ! RodTypeList + call MD_UnpackVisDiam(RF, OutData%VisRodsDiam(i1)) ! VisRodsDiam end do end if - call MD_UnpackBody(RF, OutData%GroundBody) ! GroundBody - if (allocated(OutData%BodyList)) deallocate(OutData%BodyList) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BodyList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyList.', RF%ErrStat, RF%ErrMsg, RoutineName) - return +end subroutine + +subroutine MD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(MD_InputType), intent(inout) :: SrcInputData + type(MD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%CoupledKinematics)) then + LB(1:1) = lbound(SrcInputData%CoupledKinematics) + UB(1:1) = ubound(SrcInputData%CoupledKinematics) + if (.not. allocated(DstInputData%CoupledKinematics)) then + allocate(DstInputData%CoupledKinematics(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CoupledKinematics.', ErrStat, ErrMsg, RoutineName) + return + end if end if do i1 = LB(1), UB(1) - call MD_UnpackBody(RF, OutData%BodyList(i1)) ! BodyList + call MeshCopy(SrcInputData%CoupledKinematics(i1), DstInputData%CoupledKinematics(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end if - if (allocated(OutData%RodList)) deallocate(OutData%RodList) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%RodList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodList.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + if (allocated(SrcInputData%DeltaL)) then + LB(1:1) = lbound(SrcInputData%DeltaL) + UB(1:1) = ubound(SrcInputData%DeltaL) + if (.not. allocated(DstInputData%DeltaL)) then + allocate(DstInputData%DeltaL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaL.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i1 = LB(1), UB(1) - call MD_UnpackRod(RF, OutData%RodList(i1)) ! RodList - end do + DstInputData%DeltaL = SrcInputData%DeltaL end if - if (allocated(OutData%PointList)) deallocate(OutData%PointList) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%PointList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointList.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + if (allocated(SrcInputData%DeltaLdot)) then + LB(1:1) = lbound(SrcInputData%DeltaLdot) + UB(1:1) = ubound(SrcInputData%DeltaLdot) + if (.not. allocated(DstInputData%DeltaLdot)) then + allocate(DstInputData%DeltaLdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaLdot.', ErrStat, ErrMsg, RoutineName) + return + end if end if + DstInputData%DeltaLdot = SrcInputData%DeltaLdot + end if +end subroutine + +subroutine MD_DestroyInput(InputData, ErrStat, ErrMsg) + type(MD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%CoupledKinematics)) then + LB(1:1) = lbound(InputData%CoupledKinematics) + UB(1:1) = ubound(InputData%CoupledKinematics) do i1 = LB(1), UB(1) - call MD_UnpackPoint(RF, OutData%PointList(i1)) ! PointList + call MeshDestroy( InputData%CoupledKinematics(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(InputData%CoupledKinematics) end if - if (allocated(OutData%LineList)) deallocate(OutData%LineList) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%LineList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineList.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if + if (allocated(InputData%DeltaL)) then + deallocate(InputData%DeltaL) + end if + if (allocated(InputData%DeltaLdot)) then + deallocate(InputData%DeltaLdot) + end if +end subroutine + +subroutine MD_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackInput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%CoupledKinematics)) + if (allocated(InData%CoupledKinematics)) then + call RegPackBounds(RF, 1, lbound(InData%CoupledKinematics), ubound(InData%CoupledKinematics)) + LB(1:1) = lbound(InData%CoupledKinematics) + UB(1:1) = ubound(InData%CoupledKinematics) do i1 = LB(1), UB(1) - call MD_UnpackLine(RF, OutData%LineList(i1)) ! LineList + call MeshPack(RF, InData%CoupledKinematics(i1)) end do end if - if (allocated(OutData%FailList)) deallocate(OutData%FailList) + call RegPackAlloc(RF, InData%DeltaL) + call RegPackAlloc(RF, InData%DeltaLdot) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackInput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%CoupledKinematics)) deallocate(OutData%CoupledKinematics) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%FailList(LB(1):UB(1)),stat=stat) + allocate(OutData%CoupledKinematics(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FailList.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledKinematics.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackFail(RF, OutData%FailList(i1)) ! FailList + call MeshUnpack(RF, OutData%CoupledKinematics(i1)) ! CoupledKinematics end do end if - call RegUnpackAlloc(RF, OutData%FreePointIs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%CpldPointIs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%FreeRodIs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%CpldRodIs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%FreeBodyIs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%CpldBodyIs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%LineStateIs1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%LineStateIsN); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%PointStateIs1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%PointStateIsN); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%RodStateIs1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%RodStateIsN); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BodyStateIs1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BodyStateIsN); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nxtra); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%WaveTi); if (RegCheckErr(RF, RoutineName)) return - call MD_UnpackContState(RF, OutData%xTemp) ! xTemp - call MD_UnpackContState(RF, OutData%xdTemp) ! xdTemp - call RegUnpack(RF, OutData%zeros6); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%MDWrOutput); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%PtfmInit); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BathymetryGrid); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BathGrid_Xs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BathGrid_Ys); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BathGrid_npoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DeltaL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DeltaLdot); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) - type(MD_ParameterType), intent(in) :: SrcParamData - type(MD_ParameterType), intent(inout) :: DstParamData +subroutine MD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(MD_OutputType), intent(inout) :: SrcOutputData + type(MD_OutputType), intent(inout) :: DstOutputData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2, i3, i4 - integer(B4Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'MD_CopyParam' + character(*), parameter :: RoutineName = 'MD_CopyOutput' ErrStat = ErrID_None ErrMsg = '' - DstParamData%nLineTypes = SrcParamData%nLineTypes - DstParamData%nRodTypes = SrcParamData%nRodTypes - DstParamData%nPoints = SrcParamData%nPoints - DstParamData%nPointsExtra = SrcParamData%nPointsExtra - DstParamData%nBodies = SrcParamData%nBodies - DstParamData%nRods = SrcParamData%nRods - DstParamData%nLines = SrcParamData%nLines - DstParamData%nCtrlChans = SrcParamData%nCtrlChans - DstParamData%nFails = SrcParamData%nFails - DstParamData%nFreeBodies = SrcParamData%nFreeBodies - DstParamData%nFreeRods = SrcParamData%nFreeRods - DstParamData%nFreePoints = SrcParamData%nFreePoints - if (allocated(SrcParamData%nCpldBodies)) then - LB(1:1) = lbound(SrcParamData%nCpldBodies) - UB(1:1) = ubound(SrcParamData%nCpldBodies) - if (.not. allocated(DstParamData%nCpldBodies)) then - allocate(DstParamData%nCpldBodies(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%CoupledLoads)) then + LB(1:1) = lbound(SrcOutputData%CoupledLoads) + UB(1:1) = ubound(SrcOutputData%CoupledLoads) + if (.not. allocated(DstOutputData%CoupledLoads)) then + allocate(DstOutputData%CoupledLoads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldBodies.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CoupledLoads.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%nCpldBodies = SrcParamData%nCpldBodies + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%CoupledLoads(i1), DstOutputData%CoupledLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcParamData%nCpldRods)) then - LB(1:1) = lbound(SrcParamData%nCpldRods) - UB(1:1) = ubound(SrcParamData%nCpldRods) - if (.not. allocated(DstParamData%nCpldRods)) then - allocate(DstParamData%nCpldRods(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldRods.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%nCpldRods = SrcParamData%nCpldRods + DstOutputData%WriteOutput = SrcOutputData%WriteOutput end if - if (allocated(SrcParamData%nCpldPoints)) then - LB(1:1) = lbound(SrcParamData%nCpldPoints) - UB(1:1) = ubound(SrcParamData%nCpldPoints) - if (.not. allocated(DstParamData%nCpldPoints)) then - allocate(DstParamData%nCpldPoints(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%VisLinesMesh)) then + LB(1:1) = lbound(SrcOutputData%VisLinesMesh) + UB(1:1) = ubound(SrcOutputData%VisLinesMesh) + if (.not. allocated(DstOutputData%VisLinesMesh)) then + allocate(DstOutputData%VisLinesMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldPoints.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisLinesMesh.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%nCpldPoints = SrcParamData%nCpldPoints + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%VisLinesMesh(i1), DstOutputData%VisLinesMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - DstParamData%NConns = SrcParamData%NConns - DstParamData%NAnchs = SrcParamData%NAnchs - DstParamData%Tmax = SrcParamData%Tmax - DstParamData%g = SrcParamData%g - DstParamData%rhoW = SrcParamData%rhoW - DstParamData%WtrDpth = SrcParamData%WtrDpth - DstParamData%kBot = SrcParamData%kBot - DstParamData%cBot = SrcParamData%cBot - DstParamData%dtM0 = SrcParamData%dtM0 - DstParamData%dtCoupling = SrcParamData%dtCoupling - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%dtOut = SrcParamData%dtOut - DstParamData%RootName = SrcParamData%RootName - if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam) - UB(1:1) = ubound(SrcParamData%OutParam) - if (.not. allocated(DstParamData%OutParam)) then - allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%VisRodsMesh)) then + LB(1:1) = lbound(SrcOutputData%VisRodsMesh) + UB(1:1) = ubound(SrcOutputData%VisRodsMesh) + if (.not. allocated(DstOutputData%VisRodsMesh)) then + allocate(DstOutputData%VisRodsMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisRodsMesh.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MD_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call MeshCopy(SrcOutputData%VisRodsMesh(i1), DstOutputData%VisRodsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - DstParamData%Delim = SrcParamData%Delim - DstParamData%MDUnOut = SrcParamData%MDUnOut - DstParamData%PriPath = SrcParamData%PriPath - DstParamData%writeLog = SrcParamData%writeLog - DstParamData%UnLog = SrcParamData%UnLog - DstParamData%WaveKin = SrcParamData%WaveKin - DstParamData%Current = SrcParamData%Current - DstParamData%nTurbines = SrcParamData%nTurbines - if (allocated(SrcParamData%TurbineRefPos)) then - LB(1:2) = lbound(SrcParamData%TurbineRefPos) - UB(1:2) = ubound(SrcParamData%TurbineRefPos) - if (.not. allocated(DstParamData%TurbineRefPos)) then - allocate(DstParamData%TurbineRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TurbineRefPos.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%TurbineRefPos = SrcParamData%TurbineRefPos - end if - DstParamData%mu_kT = SrcParamData%mu_kT - DstParamData%mu_kA = SrcParamData%mu_kA - DstParamData%mc = SrcParamData%mc - DstParamData%cv = SrcParamData%cv - DstParamData%inertialF = SrcParamData%inertialF - DstParamData%inertialF_rampT = SrcParamData%inertialF_rampT - DstParamData%nxWave = SrcParamData%nxWave - DstParamData%nyWave = SrcParamData%nyWave - DstParamData%nzWave = SrcParamData%nzWave - DstParamData%ntWave = SrcParamData%ntWave - if (allocated(SrcParamData%pxWave)) then - LB(1:1) = lbound(SrcParamData%pxWave) - UB(1:1) = ubound(SrcParamData%pxWave) - if (.not. allocated(DstParamData%pxWave)) then - allocate(DstParamData%pxWave(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pxWave.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%pxWave = SrcParamData%pxWave - end if - if (allocated(SrcParamData%pyWave)) then - LB(1:1) = lbound(SrcParamData%pyWave) - UB(1:1) = ubound(SrcParamData%pyWave) - if (.not. allocated(DstParamData%pyWave)) then - allocate(DstParamData%pyWave(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%VisBodiesMesh)) then + LB(1:1) = lbound(SrcOutputData%VisBodiesMesh) + UB(1:1) = ubound(SrcOutputData%VisBodiesMesh) + if (.not. allocated(DstOutputData%VisBodiesMesh)) then + allocate(DstOutputData%VisBodiesMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pyWave.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisBodiesMesh.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%pyWave = SrcParamData%pyWave + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%VisBodiesMesh(i1), DstOutputData%VisBodiesMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcParamData%pzWave)) then - LB(1:1) = lbound(SrcParamData%pzWave) - UB(1:1) = ubound(SrcParamData%pzWave) - if (.not. allocated(DstParamData%pzWave)) then - allocate(DstParamData%pzWave(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%VisAnchsMesh)) then + LB(1:1) = lbound(SrcOutputData%VisAnchsMesh) + UB(1:1) = ubound(SrcOutputData%VisAnchsMesh) + if (.not. allocated(DstOutputData%VisAnchsMesh)) then + allocate(DstOutputData%VisAnchsMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzWave.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisAnchsMesh.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%pzWave = SrcParamData%pzWave + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%VisAnchsMesh(i1), DstOutputData%VisAnchsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - DstParamData%dtWave = SrcParamData%dtWave - if (allocated(SrcParamData%uxWave)) then - LB(1:4) = lbound(SrcParamData%uxWave) - UB(1:4) = ubound(SrcParamData%uxWave) - if (.not. allocated(DstParamData%uxWave)) then - allocate(DstParamData%uxWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uxWave.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%uxWave = SrcParamData%uxWave +end subroutine + +subroutine MD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(MD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%CoupledLoads)) then + LB(1:1) = lbound(OutputData%CoupledLoads) + UB(1:1) = ubound(OutputData%CoupledLoads) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%CoupledLoads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%CoupledLoads) end if - if (allocated(SrcParamData%uyWave)) then - LB(1:4) = lbound(SrcParamData%uyWave) - UB(1:4) = ubound(SrcParamData%uyWave) - if (.not. allocated(DstParamData%uyWave)) then - allocate(DstParamData%uyWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyWave.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%uyWave = SrcParamData%uyWave + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) end if - if (allocated(SrcParamData%uzWave)) then - LB(1:4) = lbound(SrcParamData%uzWave) - UB(1:4) = ubound(SrcParamData%uzWave) - if (.not. allocated(DstParamData%uzWave)) then - allocate(DstParamData%uzWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uzWave.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%uzWave = SrcParamData%uzWave + if (allocated(OutputData%VisLinesMesh)) then + LB(1:1) = lbound(OutputData%VisLinesMesh) + UB(1:1) = ubound(OutputData%VisLinesMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%VisLinesMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%VisLinesMesh) end if - if (allocated(SrcParamData%axWave)) then - LB(1:4) = lbound(SrcParamData%axWave) - UB(1:4) = ubound(SrcParamData%axWave) - if (.not. allocated(DstParamData%axWave)) then - allocate(DstParamData%axWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%axWave.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%axWave = SrcParamData%axWave + if (allocated(OutputData%VisRodsMesh)) then + LB(1:1) = lbound(OutputData%VisRodsMesh) + UB(1:1) = ubound(OutputData%VisRodsMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%VisRodsMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%VisRodsMesh) end if - if (allocated(SrcParamData%ayWave)) then - LB(1:4) = lbound(SrcParamData%ayWave) - UB(1:4) = ubound(SrcParamData%ayWave) - if (.not. allocated(DstParamData%ayWave)) then - allocate(DstParamData%ayWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ayWave.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%ayWave = SrcParamData%ayWave + if (allocated(OutputData%VisBodiesMesh)) then + LB(1:1) = lbound(OutputData%VisBodiesMesh) + UB(1:1) = ubound(OutputData%VisBodiesMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%VisBodiesMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%VisBodiesMesh) end if - if (allocated(SrcParamData%azWave)) then - LB(1:4) = lbound(SrcParamData%azWave) - UB(1:4) = ubound(SrcParamData%azWave) - if (.not. allocated(DstParamData%azWave)) then - allocate(DstParamData%azWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%azWave.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%azWave = SrcParamData%azWave + if (allocated(OutputData%VisAnchsMesh)) then + LB(1:1) = lbound(OutputData%VisAnchsMesh) + UB(1:1) = ubound(OutputData%VisAnchsMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%VisAnchsMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%VisAnchsMesh) end if - if (allocated(SrcParamData%PDyn)) then - LB(1:4) = lbound(SrcParamData%PDyn) - UB(1:4) = ubound(SrcParamData%PDyn) - if (.not. allocated(DstParamData%PDyn)) then - allocate(DstParamData%PDyn(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PDyn.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%PDyn = SrcParamData%PDyn +end subroutine + +subroutine MD_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%CoupledLoads)) + if (allocated(InData%CoupledLoads)) then + call RegPackBounds(RF, 1, lbound(InData%CoupledLoads), ubound(InData%CoupledLoads)) + LB(1:1) = lbound(InData%CoupledLoads) + UB(1:1) = ubound(InData%CoupledLoads) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%CoupledLoads(i1)) + end do end if - if (allocated(SrcParamData%zeta)) then - LB(1:3) = lbound(SrcParamData%zeta) - UB(1:3) = ubound(SrcParamData%zeta) - if (.not. allocated(DstParamData%zeta)) then - allocate(DstParamData%zeta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%zeta.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%zeta = SrcParamData%zeta + call RegPackAlloc(RF, InData%WriteOutput) + call RegPack(RF, allocated(InData%VisLinesMesh)) + if (allocated(InData%VisLinesMesh)) then + call RegPackBounds(RF, 1, lbound(InData%VisLinesMesh), ubound(InData%VisLinesMesh)) + LB(1:1) = lbound(InData%VisLinesMesh) + UB(1:1) = ubound(InData%VisLinesMesh) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%VisLinesMesh(i1)) + end do end if - DstParamData%nzCurrent = SrcParamData%nzCurrent - if (allocated(SrcParamData%pzCurrent)) then - LB(1:1) = lbound(SrcParamData%pzCurrent) - UB(1:1) = ubound(SrcParamData%pzCurrent) - if (.not. allocated(DstParamData%pzCurrent)) then - allocate(DstParamData%pzCurrent(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzCurrent.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%pzCurrent = SrcParamData%pzCurrent + call RegPack(RF, allocated(InData%VisRodsMesh)) + if (allocated(InData%VisRodsMesh)) then + call RegPackBounds(RF, 1, lbound(InData%VisRodsMesh), ubound(InData%VisRodsMesh)) + LB(1:1) = lbound(InData%VisRodsMesh) + UB(1:1) = ubound(InData%VisRodsMesh) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%VisRodsMesh(i1)) + end do end if - if (allocated(SrcParamData%uxCurrent)) then - LB(1:1) = lbound(SrcParamData%uxCurrent) - UB(1:1) = ubound(SrcParamData%uxCurrent) - if (.not. allocated(DstParamData%uxCurrent)) then - allocate(DstParamData%uxCurrent(LB(1):UB(1)), stat=ErrStat2) + call RegPack(RF, allocated(InData%VisBodiesMesh)) + if (allocated(InData%VisBodiesMesh)) then + call RegPackBounds(RF, 1, lbound(InData%VisBodiesMesh), ubound(InData%VisBodiesMesh)) + LB(1:1) = lbound(InData%VisBodiesMesh) + UB(1:1) = ubound(InData%VisBodiesMesh) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%VisBodiesMesh(i1)) + end do + end if + call RegPack(RF, allocated(InData%VisAnchsMesh)) + if (allocated(InData%VisAnchsMesh)) then + call RegPackBounds(RF, 1, lbound(InData%VisAnchsMesh), ubound(InData%VisAnchsMesh)) + LB(1:1) = lbound(InData%VisAnchsMesh) + UB(1:1) = ubound(InData%VisAnchsMesh) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%VisAnchsMesh(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%CoupledLoads)) deallocate(OutData%CoupledLoads) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%CoupledLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledLoads.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%CoupledLoads(i1)) ! CoupledLoads + end do + end if + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%VisLinesMesh)) deallocate(OutData%VisLinesMesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%VisLinesMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisLinesMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%VisLinesMesh(i1)) ! VisLinesMesh + end do + end if + if (allocated(OutData%VisRodsMesh)) deallocate(OutData%VisRodsMesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%VisRodsMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisRodsMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%VisRodsMesh(i1)) ! VisRodsMesh + end do + end if + if (allocated(OutData%VisBodiesMesh)) deallocate(OutData%VisBodiesMesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%VisBodiesMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisBodiesMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%VisBodiesMesh(i1)) ! VisBodiesMesh + end do + end if + if (allocated(OutData%VisAnchsMesh)) deallocate(OutData%VisAnchsMesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%VisAnchsMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisAnchsMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%VisAnchsMesh(i1)) ! VisAnchsMesh + end do + end if +end subroutine + +subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(MD_MiscVarType), intent(inout) :: SrcMiscData + type(MD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%LineTypeList)) then + LB(1:1) = lbound(SrcMiscData%LineTypeList) + UB(1:1) = ubound(SrcMiscData%LineTypeList) + if (.not. allocated(DstMiscData%LineTypeList)) then + allocate(DstMiscData%LineTypeList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uxCurrent.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineTypeList.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%uxCurrent = SrcParamData%uxCurrent + do i1 = LB(1), UB(1) + call MD_CopyLineProp(SrcMiscData%LineTypeList(i1), DstMiscData%LineTypeList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcParamData%uyCurrent)) then - LB(1:1) = lbound(SrcParamData%uyCurrent) - UB(1:1) = ubound(SrcParamData%uyCurrent) - if (.not. allocated(DstParamData%uyCurrent)) then - allocate(DstParamData%uyCurrent(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%RodTypeList)) then + LB(1:1) = lbound(SrcMiscData%RodTypeList) + UB(1:1) = ubound(SrcMiscData%RodTypeList) + if (.not. allocated(DstMiscData%RodTypeList)) then + allocate(DstMiscData%RodTypeList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyCurrent.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodTypeList.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%uyCurrent = SrcParamData%uyCurrent + do i1 = LB(1), UB(1) + call MD_CopyRodProp(SrcMiscData%RodTypeList(i1), DstMiscData%RodTypeList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - DstParamData%Nx0 = SrcParamData%Nx0 - if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx) - UB(1:2) = ubound(SrcParamData%Jac_u_indx) - if (.not. allocated(DstParamData%Jac_u_indx)) then - allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + call MD_CopyBody(SrcMiscData%GroundBody, DstMiscData%GroundBody, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%BodyList)) then + LB(1:1) = lbound(SrcMiscData%BodyList) + UB(1:1) = ubound(SrcMiscData%BodyList) + if (.not. allocated(DstMiscData%BodyList)) then + allocate(DstMiscData%BodyList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyList.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx + do i1 = LB(1), UB(1) + call MD_CopyBody(SrcMiscData%BodyList(i1), DstMiscData%BodyList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du) - UB(1:1) = ubound(SrcParamData%du) - if (.not. allocated(DstParamData%du)) then - allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%RodList)) then + LB(1:1) = lbound(SrcMiscData%RodList) + UB(1:1) = ubound(SrcMiscData%RodList) + if (.not. allocated(DstMiscData%RodList)) then + allocate(DstMiscData%RodList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodList.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%du = SrcParamData%du + do i1 = LB(1), UB(1) + call MD_CopyRod(SrcMiscData%RodList(i1), DstMiscData%RodList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcParamData%dx)) then - LB(1:1) = lbound(SrcParamData%dx) - UB(1:1) = ubound(SrcParamData%dx) - if (.not. allocated(DstParamData%dx)) then - allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%PointList)) then + LB(1:1) = lbound(SrcMiscData%PointList) + UB(1:1) = ubound(SrcMiscData%PointList) + if (.not. allocated(DstMiscData%PointList)) then + allocate(DstMiscData%PointList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointList.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%dx = SrcParamData%dx + do i1 = LB(1), UB(1) + call MD_CopyPoint(SrcMiscData%PointList(i1), DstMiscData%PointList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%Jac_nx = SrcParamData%Jac_nx - if (allocated(SrcParamData%dxIdx_map2_xStateIdx)) then - LB(1:1) = lbound(SrcParamData%dxIdx_map2_xStateIdx) - UB(1:1) = ubound(SrcParamData%dxIdx_map2_xStateIdx) - if (.not. allocated(DstParamData%dxIdx_map2_xStateIdx)) then - allocate(DstParamData%dxIdx_map2_xStateIdx(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%LineList)) then + LB(1:1) = lbound(SrcMiscData%LineList) + UB(1:1) = ubound(SrcMiscData%LineList) + if (.not. allocated(DstMiscData%LineList)) then + allocate(DstMiscData%LineList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dxIdx_map2_xStateIdx.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineList.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%dxIdx_map2_xStateIdx = SrcParamData%dxIdx_map2_xStateIdx + do i1 = LB(1), UB(1) + call MD_CopyLine(SrcMiscData%LineList(i1), DstMiscData%LineList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - DstParamData%VisMeshes = SrcParamData%VisMeshes - if (allocated(SrcParamData%VisRodsDiam)) then - LB(1:1) = lbound(SrcParamData%VisRodsDiam) - UB(1:1) = ubound(SrcParamData%VisRodsDiam) - if (.not. allocated(DstParamData%VisRodsDiam)) then - allocate(DstParamData%VisRodsDiam(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%FailList)) then + LB(1:1) = lbound(SrcMiscData%FailList) + UB(1:1) = ubound(SrcMiscData%FailList) + if (.not. allocated(DstMiscData%FailList)) then + allocate(DstMiscData%FailList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%VisRodsDiam.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FailList.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MD_CopyVisDiam(SrcParamData%VisRodsDiam(i1), DstParamData%VisRodsDiam(i1), CtrlCode, ErrStat2, ErrMsg2) + call MD_CopyFail(SrcMiscData%FailList(i1), DstMiscData%FailList(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if -end subroutine - -subroutine MD_DestroyParam(ParamData, ErrStat, ErrMsg) - type(MD_ParameterType), intent(inout) :: ParamData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2, i3, i4 - integer(B4Ki) :: LB(4), UB(4) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'MD_DestroyParam' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(ParamData%nCpldBodies)) then - deallocate(ParamData%nCpldBodies) - end if - if (allocated(ParamData%nCpldRods)) then - deallocate(ParamData%nCpldRods) - end if - if (allocated(ParamData%nCpldPoints)) then - deallocate(ParamData%nCpldPoints) - end if - if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam) - UB(1:1) = ubound(ParamData%OutParam) - do i1 = LB(1), UB(1) - call MD_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ParamData%OutParam) - end if - if (allocated(ParamData%TurbineRefPos)) then - deallocate(ParamData%TurbineRefPos) - end if - if (allocated(ParamData%pxWave)) then - deallocate(ParamData%pxWave) - end if - if (allocated(ParamData%pyWave)) then - deallocate(ParamData%pyWave) - end if - if (allocated(ParamData%pzWave)) then - deallocate(ParamData%pzWave) - end if - if (allocated(ParamData%uxWave)) then - deallocate(ParamData%uxWave) - end if - if (allocated(ParamData%uyWave)) then - deallocate(ParamData%uyWave) - end if - if (allocated(ParamData%uzWave)) then - deallocate(ParamData%uzWave) - end if - if (allocated(ParamData%axWave)) then - deallocate(ParamData%axWave) - end if - if (allocated(ParamData%ayWave)) then - deallocate(ParamData%ayWave) - end if - if (allocated(ParamData%azWave)) then - deallocate(ParamData%azWave) - end if - if (allocated(ParamData%PDyn)) then - deallocate(ParamData%PDyn) - end if - if (allocated(ParamData%zeta)) then - deallocate(ParamData%zeta) - end if - if (allocated(ParamData%pzCurrent)) then - deallocate(ParamData%pzCurrent) - end if - if (allocated(ParamData%uxCurrent)) then - deallocate(ParamData%uxCurrent) - end if - if (allocated(ParamData%uyCurrent)) then - deallocate(ParamData%uyCurrent) - end if - if (allocated(ParamData%Jac_u_indx)) then - deallocate(ParamData%Jac_u_indx) - end if - if (allocated(ParamData%du)) then - deallocate(ParamData%du) - end if - if (allocated(ParamData%dx)) then - deallocate(ParamData%dx) - end if - if (allocated(ParamData%dxIdx_map2_xStateIdx)) then - deallocate(ParamData%dxIdx_map2_xStateIdx) - end if - if (allocated(ParamData%VisRodsDiam)) then - LB(1:1) = lbound(ParamData%VisRodsDiam) - UB(1:1) = ubound(ParamData%VisRodsDiam) - do i1 = LB(1), UB(1) - call MD_DestroyVisDiam(ParamData%VisRodsDiam(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ParamData%VisRodsDiam) - end if -end subroutine - -subroutine MD_PackParam(RF, Indata) - type(RegFile), intent(inout) :: RF - type(MD_ParameterType), intent(in) :: InData - character(*), parameter :: RoutineName = 'MD_PackParam' - integer(B4Ki) :: i1, i2, i3, i4 - integer(B4Ki) :: LB(4), UB(4) - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%nLineTypes) - call RegPack(RF, InData%nRodTypes) - call RegPack(RF, InData%nPoints) - call RegPack(RF, InData%nPointsExtra) - call RegPack(RF, InData%nBodies) - call RegPack(RF, InData%nRods) - call RegPack(RF, InData%nLines) - call RegPack(RF, InData%nCtrlChans) - call RegPack(RF, InData%nFails) - call RegPack(RF, InData%nFreeBodies) - call RegPack(RF, InData%nFreeRods) - call RegPack(RF, InData%nFreePoints) - call RegPackAlloc(RF, InData%nCpldBodies) - call RegPackAlloc(RF, InData%nCpldRods) - call RegPackAlloc(RF, InData%nCpldPoints) - call RegPack(RF, InData%NConns) - call RegPack(RF, InData%NAnchs) - call RegPack(RF, InData%Tmax) - call RegPack(RF, InData%g) - call RegPack(RF, InData%rhoW) - call RegPack(RF, InData%WtrDpth) - call RegPack(RF, InData%kBot) - call RegPack(RF, InData%cBot) - call RegPack(RF, InData%dtM0) - call RegPack(RF, InData%dtCoupling) - call RegPack(RF, InData%NumOuts) - call RegPack(RF, InData%dtOut) - call RegPack(RF, InData%RootName) - call RegPack(RF, allocated(InData%OutParam)) - if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) - LB(1:1) = lbound(InData%OutParam) - UB(1:1) = ubound(InData%OutParam) - do i1 = LB(1), UB(1) - call MD_PackOutParmType(RF, InData%OutParam(i1)) - end do - end if - call RegPack(RF, InData%Delim) - call RegPack(RF, InData%MDUnOut) - call RegPack(RF, InData%PriPath) - call RegPack(RF, InData%writeLog) - call RegPack(RF, InData%UnLog) - call RegPack(RF, InData%WaveKin) - call RegPack(RF, InData%Current) - call RegPack(RF, InData%nTurbines) - call RegPackAlloc(RF, InData%TurbineRefPos) - call RegPack(RF, InData%mu_kT) - call RegPack(RF, InData%mu_kA) - call RegPack(RF, InData%mc) - call RegPack(RF, InData%cv) - call RegPack(RF, InData%inertialF) - call RegPack(RF, InData%inertialF_rampT) - call RegPack(RF, InData%nxWave) - call RegPack(RF, InData%nyWave) - call RegPack(RF, InData%nzWave) - call RegPack(RF, InData%ntWave) - call RegPackAlloc(RF, InData%pxWave) - call RegPackAlloc(RF, InData%pyWave) - call RegPackAlloc(RF, InData%pzWave) - call RegPack(RF, InData%dtWave) - call RegPackAlloc(RF, InData%uxWave) - call RegPackAlloc(RF, InData%uyWave) - call RegPackAlloc(RF, InData%uzWave) - call RegPackAlloc(RF, InData%axWave) - call RegPackAlloc(RF, InData%ayWave) - call RegPackAlloc(RF, InData%azWave) - call RegPackAlloc(RF, InData%PDyn) - call RegPackAlloc(RF, InData%zeta) - call RegPack(RF, InData%nzCurrent) - call RegPackAlloc(RF, InData%pzCurrent) - call RegPackAlloc(RF, InData%uxCurrent) - call RegPackAlloc(RF, InData%uyCurrent) - call RegPack(RF, InData%Nx0) - call RegPackAlloc(RF, InData%Jac_u_indx) - call RegPackAlloc(RF, InData%du) - call RegPackAlloc(RF, InData%dx) - call RegPack(RF, InData%Jac_ny) - call RegPack(RF, InData%Jac_nx) - call RegPackAlloc(RF, InData%dxIdx_map2_xStateIdx) - call RegPack(RF, InData%VisMeshes) - call RegPack(RF, allocated(InData%VisRodsDiam)) - if (allocated(InData%VisRodsDiam)) then - call RegPackBounds(RF, 1, lbound(InData%VisRodsDiam), ubound(InData%VisRodsDiam)) - LB(1:1) = lbound(InData%VisRodsDiam) - UB(1:1) = ubound(InData%VisRodsDiam) - do i1 = LB(1), UB(1) - call MD_PackVisDiam(RF, InData%VisRodsDiam(i1)) - end do + if (allocated(SrcMiscData%FreePointIs)) then + LB(1:1) = lbound(SrcMiscData%FreePointIs) + UB(1:1) = ubound(SrcMiscData%FreePointIs) + if (.not. allocated(DstMiscData%FreePointIs)) then + allocate(DstMiscData%FreePointIs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreePointIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FreePointIs = SrcMiscData%FreePointIs end if - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine MD_UnPackParam(RF, OutData) - type(RegFile), intent(inout) :: RF - type(MD_ParameterType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'MD_UnPackParam' - integer(B4Ki) :: i1, i2, i3, i4 - integer(B4Ki) :: LB(4), UB(4) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%nLineTypes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nRodTypes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nPoints); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nPointsExtra); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nBodies); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nRods); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nLines); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nCtrlChans); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nFails); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nFreeBodies); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nFreeRods); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nFreePoints); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%nCpldBodies); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%nCpldRods); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%nCpldPoints); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NConns); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NAnchs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Tmax); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%g); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%rhoW); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%kBot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%cBot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%dtM0); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%dtCoupling); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%dtOut); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + if (allocated(SrcMiscData%CpldPointIs)) then + LB(1:2) = lbound(SrcMiscData%CpldPointIs) + UB(1:2) = ubound(SrcMiscData%CpldPointIs) + if (.not. allocated(DstMiscData%CpldPointIs)) then + allocate(DstMiscData%CpldPointIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldPointIs.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i1 = LB(1), UB(1) - call MD_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam - end do + DstMiscData%CpldPointIs = SrcMiscData%CpldPointIs end if - call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%MDUnOut); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%PriPath); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%writeLog); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%UnLog); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%WaveKin); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Current); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nTurbines); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TurbineRefPos); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%mu_kT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%mu_kA); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%mc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%cv); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%inertialF); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%inertialF_rampT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nxWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nyWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nzWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ntWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%pxWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%pyWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%pzWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%dtWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%uxWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%uyWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%uzWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%axWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ayWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%azWave); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%PDyn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%zeta); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%nzCurrent); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%pzCurrent); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%uxCurrent); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%uyCurrent); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Nx0); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_nx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dxIdx_map2_xStateIdx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VisMeshes); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%VisRodsDiam)) deallocate(OutData%VisRodsDiam) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%VisRodsDiam(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisRodsDiam.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + if (allocated(SrcMiscData%FreeRodIs)) then + LB(1:1) = lbound(SrcMiscData%FreeRodIs) + UB(1:1) = ubound(SrcMiscData%FreeRodIs) + if (.not. allocated(DstMiscData%FreeRodIs)) then + allocate(DstMiscData%FreeRodIs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeRodIs.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i1 = LB(1), UB(1) - call MD_UnpackVisDiam(RF, OutData%VisRodsDiam(i1)) ! VisRodsDiam - end do + DstMiscData%FreeRodIs = SrcMiscData%FreeRodIs end if -end subroutine - -subroutine MD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) - type(MD_InputType), intent(inout) :: SrcInputData - type(MD_InputType), intent(inout) :: DstInputData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'MD_CopyInput' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcInputData%CoupledKinematics)) then - LB(1:1) = lbound(SrcInputData%CoupledKinematics) - UB(1:1) = ubound(SrcInputData%CoupledKinematics) - if (.not. allocated(DstInputData%CoupledKinematics)) then - allocate(DstInputData%CoupledKinematics(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%CpldRodIs)) then + LB(1:2) = lbound(SrcMiscData%CpldRodIs) + UB(1:2) = ubound(SrcMiscData%CpldRodIs) + if (.not. allocated(DstMiscData%CpldRodIs)) then + allocate(DstMiscData%CpldRodIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CoupledKinematics.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldRodIs.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MeshCopy(SrcInputData%CoupledKinematics(i1), DstInputData%CoupledKinematics(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstMiscData%CpldRodIs = SrcMiscData%CpldRodIs end if - if (allocated(SrcInputData%DeltaL)) then - LB(1:1) = lbound(SrcInputData%DeltaL) - UB(1:1) = ubound(SrcInputData%DeltaL) - if (.not. allocated(DstInputData%DeltaL)) then - allocate(DstInputData%DeltaL(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%FreeBodyIs)) then + LB(1:1) = lbound(SrcMiscData%FreeBodyIs) + UB(1:1) = ubound(SrcMiscData%FreeBodyIs) + if (.not. allocated(DstMiscData%FreeBodyIs)) then + allocate(DstMiscData%FreeBodyIs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaL.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeBodyIs.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputData%DeltaL = SrcInputData%DeltaL + DstMiscData%FreeBodyIs = SrcMiscData%FreeBodyIs end if - if (allocated(SrcInputData%DeltaLdot)) then - LB(1:1) = lbound(SrcInputData%DeltaLdot) - UB(1:1) = ubound(SrcInputData%DeltaLdot) - if (.not. allocated(DstInputData%DeltaLdot)) then - allocate(DstInputData%DeltaLdot(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%CpldBodyIs)) then + LB(1:2) = lbound(SrcMiscData%CpldBodyIs) + UB(1:2) = ubound(SrcMiscData%CpldBodyIs) + if (.not. allocated(DstMiscData%CpldBodyIs)) then + allocate(DstMiscData%CpldBodyIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaLdot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldBodyIs.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputData%DeltaLdot = SrcInputData%DeltaLdot + DstMiscData%CpldBodyIs = SrcMiscData%CpldBodyIs end if -end subroutine - -subroutine MD_DestroyInput(InputData, ErrStat, ErrMsg) - type(MD_InputType), intent(inout) :: InputData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'MD_DestroyInput' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(InputData%CoupledKinematics)) then - LB(1:1) = lbound(InputData%CoupledKinematics) - UB(1:1) = ubound(InputData%CoupledKinematics) - do i1 = LB(1), UB(1) - call MeshDestroy( InputData%CoupledKinematics(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(InputData%CoupledKinematics) + if (allocated(SrcMiscData%LineStateIs1)) then + LB(1:1) = lbound(SrcMiscData%LineStateIs1) + UB(1:1) = ubound(SrcMiscData%LineStateIs1) + if (.not. allocated(DstMiscData%LineStateIs1)) then + allocate(DstMiscData%LineStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIs1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LineStateIs1 = SrcMiscData%LineStateIs1 end if - if (allocated(InputData%DeltaL)) then - deallocate(InputData%DeltaL) + if (allocated(SrcMiscData%LineStateIsN)) then + LB(1:1) = lbound(SrcMiscData%LineStateIsN) + UB(1:1) = ubound(SrcMiscData%LineStateIsN) + if (.not. allocated(DstMiscData%LineStateIsN)) then + allocate(DstMiscData%LineStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIsN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LineStateIsN = SrcMiscData%LineStateIsN end if - if (allocated(InputData%DeltaLdot)) then - deallocate(InputData%DeltaLdot) + if (allocated(SrcMiscData%PointStateIs1)) then + LB(1:1) = lbound(SrcMiscData%PointStateIs1) + UB(1:1) = ubound(SrcMiscData%PointStateIs1) + if (.not. allocated(DstMiscData%PointStateIs1)) then + allocate(DstMiscData%PointStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointStateIs1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%PointStateIs1 = SrcMiscData%PointStateIs1 end if -end subroutine - -subroutine MD_PackInput(RF, Indata) - type(RegFile), intent(inout) :: RF - type(MD_InputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'MD_PackInput' - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%CoupledKinematics)) - if (allocated(InData%CoupledKinematics)) then - call RegPackBounds(RF, 1, lbound(InData%CoupledKinematics), ubound(InData%CoupledKinematics)) - LB(1:1) = lbound(InData%CoupledKinematics) - UB(1:1) = ubound(InData%CoupledKinematics) - do i1 = LB(1), UB(1) - call MeshPack(RF, InData%CoupledKinematics(i1)) - end do + if (allocated(SrcMiscData%PointStateIsN)) then + LB(1:1) = lbound(SrcMiscData%PointStateIsN) + UB(1:1) = ubound(SrcMiscData%PointStateIsN) + if (.not. allocated(DstMiscData%PointStateIsN)) then + allocate(DstMiscData%PointStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointStateIsN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%PointStateIsN = SrcMiscData%PointStateIsN end if - call RegPackAlloc(RF, InData%DeltaL) - call RegPackAlloc(RF, InData%DeltaLdot) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine MD_UnPackInput(RF, OutData) - type(RegFile), intent(inout) :: RF - type(MD_InputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'MD_UnPackInput' - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%CoupledKinematics)) deallocate(OutData%CoupledKinematics) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%CoupledKinematics(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledKinematics.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + if (allocated(SrcMiscData%RodStateIs1)) then + LB(1:1) = lbound(SrcMiscData%RodStateIs1) + UB(1:1) = ubound(SrcMiscData%RodStateIs1) + if (.not. allocated(DstMiscData%RodStateIs1)) then + allocate(DstMiscData%RodStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIs1.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%CoupledKinematics(i1)) ! CoupledKinematics - end do + DstMiscData%RodStateIs1 = SrcMiscData%RodStateIs1 end if - call RegUnpackAlloc(RF, OutData%DeltaL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%DeltaLdot); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine MD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) - type(MD_OutputType), intent(inout) :: SrcOutputData - type(MD_OutputType), intent(inout) :: DstOutputData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'MD_CopyOutput' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcOutputData%CoupledLoads)) then - LB(1:1) = lbound(SrcOutputData%CoupledLoads) - UB(1:1) = ubound(SrcOutputData%CoupledLoads) - if (.not. allocated(DstOutputData%CoupledLoads)) then - allocate(DstOutputData%CoupledLoads(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%RodStateIsN)) then + LB(1:1) = lbound(SrcMiscData%RodStateIsN) + UB(1:1) = ubound(SrcMiscData%RodStateIsN) + if (.not. allocated(DstMiscData%RodStateIsN)) then + allocate(DstMiscData%RodStateIsN(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CoupledLoads.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIsN.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%CoupledLoads(i1), DstOutputData%CoupledLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstMiscData%RodStateIsN = SrcMiscData%RodStateIsN end if - if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) - if (.not. allocated(DstOutputData%WriteOutput)) then - allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%BodyStateIs1)) then + LB(1:1) = lbound(SrcMiscData%BodyStateIs1) + UB(1:1) = ubound(SrcMiscData%BodyStateIs1) + if (.not. allocated(DstMiscData%BodyStateIs1)) then + allocate(DstMiscData%BodyStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIs1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BodyStateIs1 = SrcMiscData%BodyStateIs1 + end if + if (allocated(SrcMiscData%BodyStateIsN)) then + LB(1:1) = lbound(SrcMiscData%BodyStateIsN) + UB(1:1) = ubound(SrcMiscData%BodyStateIsN) + if (.not. allocated(DstMiscData%BodyStateIsN)) then + allocate(DstMiscData%BodyStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIsN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BodyStateIsN = SrcMiscData%BodyStateIsN + end if + DstMiscData%Nx = SrcMiscData%Nx + DstMiscData%Nxtra = SrcMiscData%Nxtra + DstMiscData%WaveTi = SrcMiscData%WaveTi + call MD_CopyContState(SrcMiscData%xTemp, DstMiscData%xTemp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyContState(SrcMiscData%xdTemp, DstMiscData%xdTemp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%zeros6 = SrcMiscData%zeros6 + if (allocated(SrcMiscData%MDWrOutput)) then + LB(1:1) = lbound(SrcMiscData%MDWrOutput) + UB(1:1) = ubound(SrcMiscData%MDWrOutput) + if (.not. allocated(DstMiscData%MDWrOutput)) then + allocate(DstMiscData%MDWrOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MDWrOutput.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%WriteOutput = SrcOutputData%WriteOutput + DstMiscData%MDWrOutput = SrcMiscData%MDWrOutput end if - if (allocated(SrcOutputData%VisLinesMesh)) then - LB(1:1) = lbound(SrcOutputData%VisLinesMesh) - UB(1:1) = ubound(SrcOutputData%VisLinesMesh) - if (.not. allocated(DstOutputData%VisLinesMesh)) then - allocate(DstOutputData%VisLinesMesh(LB(1):UB(1)), stat=ErrStat2) + DstMiscData%LastOutTime = SrcMiscData%LastOutTime + DstMiscData%PtfmInit = SrcMiscData%PtfmInit + if (allocated(SrcMiscData%BathymetryGrid)) then + LB(1:2) = lbound(SrcMiscData%BathymetryGrid) + UB(1:2) = ubound(SrcMiscData%BathymetryGrid) + if (.not. allocated(DstMiscData%BathymetryGrid)) then + allocate(DstMiscData%BathymetryGrid(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisLinesMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathymetryGrid.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%VisLinesMesh(i1), DstOutputData%VisLinesMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstMiscData%BathymetryGrid = SrcMiscData%BathymetryGrid end if - if (allocated(SrcOutputData%VisRodsMesh)) then - LB(1:1) = lbound(SrcOutputData%VisRodsMesh) - UB(1:1) = ubound(SrcOutputData%VisRodsMesh) - if (.not. allocated(DstOutputData%VisRodsMesh)) then - allocate(DstOutputData%VisRodsMesh(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%BathGrid_Xs)) then + LB(1:1) = lbound(SrcMiscData%BathGrid_Xs) + UB(1:1) = ubound(SrcMiscData%BathGrid_Xs) + if (.not. allocated(DstMiscData%BathGrid_Xs)) then + allocate(DstMiscData%BathGrid_Xs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisRodsMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Xs.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%VisRodsMesh(i1), DstOutputData%VisRodsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstMiscData%BathGrid_Xs = SrcMiscData%BathGrid_Xs end if - if (allocated(SrcOutputData%VisBodiesMesh)) then - LB(1:1) = lbound(SrcOutputData%VisBodiesMesh) - UB(1:1) = ubound(SrcOutputData%VisBodiesMesh) - if (.not. allocated(DstOutputData%VisBodiesMesh)) then - allocate(DstOutputData%VisBodiesMesh(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%BathGrid_Ys)) then + LB(1:1) = lbound(SrcMiscData%BathGrid_Ys) + UB(1:1) = ubound(SrcMiscData%BathGrid_Ys) + if (.not. allocated(DstMiscData%BathGrid_Ys)) then + allocate(DstMiscData%BathGrid_Ys(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisBodiesMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Ys.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%VisBodiesMesh(i1), DstOutputData%VisBodiesMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstMiscData%BathGrid_Ys = SrcMiscData%BathGrid_Ys end if - if (allocated(SrcOutputData%VisAnchsMesh)) then - LB(1:1) = lbound(SrcOutputData%VisAnchsMesh) - UB(1:1) = ubound(SrcOutputData%VisAnchsMesh) - if (.not. allocated(DstOutputData%VisAnchsMesh)) then - allocate(DstOutputData%VisAnchsMesh(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%BathGrid_npoints)) then + LB(1:1) = lbound(SrcMiscData%BathGrid_npoints) + UB(1:1) = ubound(SrcMiscData%BathGrid_npoints) + if (.not. allocated(DstMiscData%BathGrid_npoints)) then + allocate(DstMiscData%BathGrid_npoints(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisAnchsMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_npoints.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%VisAnchsMesh(i1), DstOutputData%VisAnchsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstMiscData%BathGrid_npoints = SrcMiscData%BathGrid_npoints end if end subroutine -subroutine MD_DestroyOutput(OutputData, ErrStat, ErrMsg) - type(MD_OutputType), intent(inout) :: OutputData +subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(MD_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'MD_DestroyOutput' + character(*), parameter :: RoutineName = 'MD_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' - if (allocated(OutputData%CoupledLoads)) then - LB(1:1) = lbound(OutputData%CoupledLoads) - UB(1:1) = ubound(OutputData%CoupledLoads) + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%LineTypeList)) then + LB(1:1) = lbound(MiscData%LineTypeList) + UB(1:1) = ubound(MiscData%LineTypeList) do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%CoupledLoads(i1), ErrStat2, ErrMsg2) + call MD_DestroyLineProp(MiscData%LineTypeList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(OutputData%CoupledLoads) + deallocate(MiscData%LineTypeList) end if - if (allocated(OutputData%WriteOutput)) then - deallocate(OutputData%WriteOutput) + if (allocated(MiscData%RodTypeList)) then + LB(1:1) = lbound(MiscData%RodTypeList) + UB(1:1) = ubound(MiscData%RodTypeList) + do i1 = LB(1), UB(1) + call MD_DestroyRodProp(MiscData%RodTypeList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%RodTypeList) end if - if (allocated(OutputData%VisLinesMesh)) then - LB(1:1) = lbound(OutputData%VisLinesMesh) - UB(1:1) = ubound(OutputData%VisLinesMesh) + call MD_DestroyBody(MiscData%GroundBody, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%BodyList)) then + LB(1:1) = lbound(MiscData%BodyList) + UB(1:1) = ubound(MiscData%BodyList) do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%VisLinesMesh(i1), ErrStat2, ErrMsg2) + call MD_DestroyBody(MiscData%BodyList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(OutputData%VisLinesMesh) + deallocate(MiscData%BodyList) end if - if (allocated(OutputData%VisRodsMesh)) then - LB(1:1) = lbound(OutputData%VisRodsMesh) - UB(1:1) = ubound(OutputData%VisRodsMesh) + if (allocated(MiscData%RodList)) then + LB(1:1) = lbound(MiscData%RodList) + UB(1:1) = ubound(MiscData%RodList) do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%VisRodsMesh(i1), ErrStat2, ErrMsg2) + call MD_DestroyRod(MiscData%RodList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(OutputData%VisRodsMesh) + deallocate(MiscData%RodList) end if - if (allocated(OutputData%VisBodiesMesh)) then - LB(1:1) = lbound(OutputData%VisBodiesMesh) - UB(1:1) = ubound(OutputData%VisBodiesMesh) + if (allocated(MiscData%PointList)) then + LB(1:1) = lbound(MiscData%PointList) + UB(1:1) = ubound(MiscData%PointList) do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%VisBodiesMesh(i1), ErrStat2, ErrMsg2) + call MD_DestroyPoint(MiscData%PointList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(OutputData%VisBodiesMesh) + deallocate(MiscData%PointList) end if - if (allocated(OutputData%VisAnchsMesh)) then - LB(1:1) = lbound(OutputData%VisAnchsMesh) - UB(1:1) = ubound(OutputData%VisAnchsMesh) + if (allocated(MiscData%LineList)) then + LB(1:1) = lbound(MiscData%LineList) + UB(1:1) = ubound(MiscData%LineList) do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%VisAnchsMesh(i1), ErrStat2, ErrMsg2) + call MD_DestroyLine(MiscData%LineList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(OutputData%VisAnchsMesh) + deallocate(MiscData%LineList) + end if + if (allocated(MiscData%FailList)) then + LB(1:1) = lbound(MiscData%FailList) + UB(1:1) = ubound(MiscData%FailList) + do i1 = LB(1), UB(1) + call MD_DestroyFail(MiscData%FailList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%FailList) + end if + if (allocated(MiscData%FreePointIs)) then + deallocate(MiscData%FreePointIs) + end if + if (allocated(MiscData%CpldPointIs)) then + deallocate(MiscData%CpldPointIs) + end if + if (allocated(MiscData%FreeRodIs)) then + deallocate(MiscData%FreeRodIs) + end if + if (allocated(MiscData%CpldRodIs)) then + deallocate(MiscData%CpldRodIs) + end if + if (allocated(MiscData%FreeBodyIs)) then + deallocate(MiscData%FreeBodyIs) + end if + if (allocated(MiscData%CpldBodyIs)) then + deallocate(MiscData%CpldBodyIs) + end if + if (allocated(MiscData%LineStateIs1)) then + deallocate(MiscData%LineStateIs1) + end if + if (allocated(MiscData%LineStateIsN)) then + deallocate(MiscData%LineStateIsN) + end if + if (allocated(MiscData%PointStateIs1)) then + deallocate(MiscData%PointStateIs1) + end if + if (allocated(MiscData%PointStateIsN)) then + deallocate(MiscData%PointStateIsN) + end if + if (allocated(MiscData%RodStateIs1)) then + deallocate(MiscData%RodStateIs1) + end if + if (allocated(MiscData%RodStateIsN)) then + deallocate(MiscData%RodStateIsN) + end if + if (allocated(MiscData%BodyStateIs1)) then + deallocate(MiscData%BodyStateIs1) + end if + if (allocated(MiscData%BodyStateIsN)) then + deallocate(MiscData%BodyStateIsN) + end if + call MD_DestroyContState(MiscData%xTemp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyContState(MiscData%xdTemp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%MDWrOutput)) then + deallocate(MiscData%MDWrOutput) + end if + if (allocated(MiscData%BathymetryGrid)) then + deallocate(MiscData%BathymetryGrid) + end if + if (allocated(MiscData%BathGrid_Xs)) then + deallocate(MiscData%BathGrid_Xs) + end if + if (allocated(MiscData%BathGrid_Ys)) then + deallocate(MiscData%BathGrid_Ys) + end if + if (allocated(MiscData%BathGrid_npoints)) then + deallocate(MiscData%BathGrid_npoints) end if end subroutine -subroutine MD_PackOutput(RF, Indata) +subroutine MD_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF - type(MD_OutputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'MD_PackOutput' - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) + type(MD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackMisc' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%CoupledLoads)) - if (allocated(InData%CoupledLoads)) then - call RegPackBounds(RF, 1, lbound(InData%CoupledLoads), ubound(InData%CoupledLoads)) - LB(1:1) = lbound(InData%CoupledLoads) - UB(1:1) = ubound(InData%CoupledLoads) + call NWTC_Library_PackModJacType(RF, InData%Jac) + call MD_PackContState(RF, InData%x_perturb) + call MD_PackContState(RF, InData%dxdt_lin) + call MD_PackInput(RF, InData%u_perturb) + call MD_PackOutput(RF, InData%y_lin) + call RegPack(RF, allocated(InData%LineTypeList)) + if (allocated(InData%LineTypeList)) then + call RegPackBounds(RF, 1, lbound(InData%LineTypeList), ubound(InData%LineTypeList)) + LB(1:1) = lbound(InData%LineTypeList) + UB(1:1) = ubound(InData%LineTypeList) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%CoupledLoads(i1)) + call MD_PackLineProp(RF, InData%LineTypeList(i1)) end do end if - call RegPackAlloc(RF, InData%WriteOutput) - call RegPack(RF, allocated(InData%VisLinesMesh)) - if (allocated(InData%VisLinesMesh)) then - call RegPackBounds(RF, 1, lbound(InData%VisLinesMesh), ubound(InData%VisLinesMesh)) - LB(1:1) = lbound(InData%VisLinesMesh) - UB(1:1) = ubound(InData%VisLinesMesh) + call RegPack(RF, allocated(InData%RodTypeList)) + if (allocated(InData%RodTypeList)) then + call RegPackBounds(RF, 1, lbound(InData%RodTypeList), ubound(InData%RodTypeList)) + LB(1:1) = lbound(InData%RodTypeList) + UB(1:1) = ubound(InData%RodTypeList) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%VisLinesMesh(i1)) + call MD_PackRodProp(RF, InData%RodTypeList(i1)) end do end if - call RegPack(RF, allocated(InData%VisRodsMesh)) - if (allocated(InData%VisRodsMesh)) then - call RegPackBounds(RF, 1, lbound(InData%VisRodsMesh), ubound(InData%VisRodsMesh)) - LB(1:1) = lbound(InData%VisRodsMesh) - UB(1:1) = ubound(InData%VisRodsMesh) + call MD_PackBody(RF, InData%GroundBody) + call RegPack(RF, allocated(InData%BodyList)) + if (allocated(InData%BodyList)) then + call RegPackBounds(RF, 1, lbound(InData%BodyList), ubound(InData%BodyList)) + LB(1:1) = lbound(InData%BodyList) + UB(1:1) = ubound(InData%BodyList) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%VisRodsMesh(i1)) + call MD_PackBody(RF, InData%BodyList(i1)) end do end if - call RegPack(RF, allocated(InData%VisBodiesMesh)) - if (allocated(InData%VisBodiesMesh)) then - call RegPackBounds(RF, 1, lbound(InData%VisBodiesMesh), ubound(InData%VisBodiesMesh)) - LB(1:1) = lbound(InData%VisBodiesMesh) - UB(1:1) = ubound(InData%VisBodiesMesh) + call RegPack(RF, allocated(InData%RodList)) + if (allocated(InData%RodList)) then + call RegPackBounds(RF, 1, lbound(InData%RodList), ubound(InData%RodList)) + LB(1:1) = lbound(InData%RodList) + UB(1:1) = ubound(InData%RodList) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%VisBodiesMesh(i1)) + call MD_PackRod(RF, InData%RodList(i1)) end do end if - call RegPack(RF, allocated(InData%VisAnchsMesh)) - if (allocated(InData%VisAnchsMesh)) then - call RegPackBounds(RF, 1, lbound(InData%VisAnchsMesh), ubound(InData%VisAnchsMesh)) - LB(1:1) = lbound(InData%VisAnchsMesh) - UB(1:1) = ubound(InData%VisAnchsMesh) + call RegPack(RF, allocated(InData%PointList)) + if (allocated(InData%PointList)) then + call RegPackBounds(RF, 1, lbound(InData%PointList), ubound(InData%PointList)) + LB(1:1) = lbound(InData%PointList) + UB(1:1) = ubound(InData%PointList) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%VisAnchsMesh(i1)) + call MD_PackPoint(RF, InData%PointList(i1)) + end do + end if + call RegPack(RF, allocated(InData%LineList)) + if (allocated(InData%LineList)) then + call RegPackBounds(RF, 1, lbound(InData%LineList), ubound(InData%LineList)) + LB(1:1) = lbound(InData%LineList) + UB(1:1) = ubound(InData%LineList) + do i1 = LB(1), UB(1) + call MD_PackLine(RF, InData%LineList(i1)) + end do + end if + call RegPack(RF, allocated(InData%FailList)) + if (allocated(InData%FailList)) then + call RegPackBounds(RF, 1, lbound(InData%FailList), ubound(InData%FailList)) + LB(1:1) = lbound(InData%FailList) + UB(1:1) = ubound(InData%FailList) + do i1 = LB(1), UB(1) + call MD_PackFail(RF, InData%FailList(i1)) end do end if + call RegPackAlloc(RF, InData%FreePointIs) + call RegPackAlloc(RF, InData%CpldPointIs) + call RegPackAlloc(RF, InData%FreeRodIs) + call RegPackAlloc(RF, InData%CpldRodIs) + call RegPackAlloc(RF, InData%FreeBodyIs) + call RegPackAlloc(RF, InData%CpldBodyIs) + call RegPackAlloc(RF, InData%LineStateIs1) + call RegPackAlloc(RF, InData%LineStateIsN) + call RegPackAlloc(RF, InData%PointStateIs1) + call RegPackAlloc(RF, InData%PointStateIsN) + call RegPackAlloc(RF, InData%RodStateIs1) + call RegPackAlloc(RF, InData%RodStateIsN) + call RegPackAlloc(RF, InData%BodyStateIs1) + call RegPackAlloc(RF, InData%BodyStateIsN) + call RegPack(RF, InData%Nx) + call RegPack(RF, InData%Nxtra) + call RegPack(RF, InData%WaveTi) + call MD_PackContState(RF, InData%xTemp) + call MD_PackContState(RF, InData%xdTemp) + call RegPack(RF, InData%zeros6) + call RegPackAlloc(RF, InData%MDWrOutput) + call RegPack(RF, InData%LastOutTime) + call RegPack(RF, InData%PtfmInit) + call RegPackAlloc(RF, InData%BathymetryGrid) + call RegPackAlloc(RF, InData%BathGrid_Xs) + call RegPackAlloc(RF, InData%BathGrid_Ys) + call RegPackAlloc(RF, InData%BathGrid_npoints) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackOutput(RF, OutData) +subroutine MD_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF - type(MD_OutputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'MD_UnPackOutput' - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) + type(MD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackMisc' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%CoupledLoads)) deallocate(OutData%CoupledLoads) + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call MD_UnpackContState(RF, OutData%x_perturb) ! x_perturb + call MD_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin + call MD_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call MD_UnpackOutput(RF, OutData%y_lin) ! y_lin + if (allocated(OutData%LineTypeList)) deallocate(OutData%LineTypeList) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%CoupledLoads(LB(1):UB(1)),stat=stat) + allocate(OutData%LineTypeList(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledLoads.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineTypeList.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%CoupledLoads(i1)) ! CoupledLoads + call MD_UnpackLineProp(RF, OutData%LineTypeList(i1)) ! LineTypeList end do end if - call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%VisLinesMesh)) deallocate(OutData%VisLinesMesh) + if (allocated(OutData%RodTypeList)) deallocate(OutData%RodTypeList) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%VisLinesMesh(LB(1):UB(1)),stat=stat) + allocate(OutData%RodTypeList(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisLinesMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodTypeList.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%VisLinesMesh(i1)) ! VisLinesMesh + call MD_UnpackRodProp(RF, OutData%RodTypeList(i1)) ! RodTypeList end do end if - if (allocated(OutData%VisRodsMesh)) deallocate(OutData%VisRodsMesh) + call MD_UnpackBody(RF, OutData%GroundBody) ! GroundBody + if (allocated(OutData%BodyList)) deallocate(OutData%BodyList) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%VisRodsMesh(LB(1):UB(1)),stat=stat) + allocate(OutData%BodyList(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisRodsMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyList.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%VisRodsMesh(i1)) ! VisRodsMesh + call MD_UnpackBody(RF, OutData%BodyList(i1)) ! BodyList end do end if - if (allocated(OutData%VisBodiesMesh)) deallocate(OutData%VisBodiesMesh) + if (allocated(OutData%RodList)) deallocate(OutData%RodList) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%VisBodiesMesh(LB(1):UB(1)),stat=stat) + allocate(OutData%RodList(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisBodiesMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodList.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%VisBodiesMesh(i1)) ! VisBodiesMesh + call MD_UnpackRod(RF, OutData%RodList(i1)) ! RodList end do end if - if (allocated(OutData%VisAnchsMesh)) deallocate(OutData%VisAnchsMesh) + if (allocated(OutData%PointList)) deallocate(OutData%PointList) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%VisAnchsMesh(LB(1):UB(1)),stat=stat) + allocate(OutData%PointList(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisAnchsMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointList.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%VisAnchsMesh(i1)) ! VisAnchsMesh + call MD_UnpackPoint(RF, OutData%PointList(i1)) ! PointList + end do + end if + if (allocated(OutData%LineList)) deallocate(OutData%LineList) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%LineList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineList.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackLine(RF, OutData%LineList(i1)) ! LineList + end do + end if + if (allocated(OutData%FailList)) deallocate(OutData%FailList) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%FailList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FailList.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackFail(RF, OutData%FailList(i1)) ! FailList end do end if + call RegUnpackAlloc(RF, OutData%FreePointIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CpldPointIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FreeRodIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CpldRodIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FreeBodyIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CpldBodyIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LineStateIs1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LineStateIsN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PointStateIs1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PointStateIsN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RodStateIs1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RodStateIsN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BodyStateIs1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BodyStateIsN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nxtra); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveTi); if (RegCheckErr(RF, RoutineName)) return + call MD_UnpackContState(RF, OutData%xTemp) ! xTemp + call MD_UnpackContState(RF, OutData%xdTemp) ! xdTemp + call RegUnpack(RF, OutData%zeros6); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MDWrOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BathymetryGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BathGrid_Xs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BathGrid_Ys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BathGrid_npoints); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine MD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) @@ -5043,5 +5103,331 @@ SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err END DO END IF ! check if allocated END SUBROUTINE + +function MD_InputMeshPointer(u, DL) result(Mesh) + type(MD_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (MD_u_CoupledKinematics) + Mesh => u%CoupledKinematics(DL%i1) + end select +end function + +function MD_OutputMeshPointer(y, DL) result(Mesh) + type(MD_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (MD_y_CoupledLoads) + Mesh => y%CoupledLoads(DL%i1) + case (MD_y_VisLinesMesh) + Mesh => y%VisLinesMesh(DL%i1) + case (MD_y_VisRodsMesh) + Mesh => y%VisRodsMesh(DL%i1) + case (MD_y_VisBodiesMesh) + Mesh => y%VisBodiesMesh(DL%i1) + case (MD_y_VisAnchsMesh) + Mesh => y%VisAnchsMesh(DL%i1) + end select +end function + +subroutine MD_VarsPackContState(Vars, x, ValAry) + type(MD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call MD_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine MD_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(MD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MD_x_states) + VarVals = x%states(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine MD_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(MD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call MD_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine MD_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(MD_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MD_x_states) + x%states(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function MD_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (MD_x_states) + Name = "x%states" + case default + Name = "Unknown Field" + end select +end function + +subroutine MD_VarsPackContStateDeriv(Vars, x, ValAry) + type(MD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call MD_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine MD_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(MD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MD_x_states) + VarVals = x%states(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine MD_VarsPackConstrState(Vars, z, ValAry) + type(MD_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call MD_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine MD_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(MD_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MD_z_dummy) + VarVals(1) = z%dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine MD_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(MD_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call MD_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine MD_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(MD_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MD_z_dummy) + z%dummy = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function MD_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (MD_z_dummy) + Name = "z%dummy" + case default + Name = "Unknown Field" + end select +end function + +subroutine MD_VarsPackInput(Vars, u, ValAry) + type(MD_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call MD_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine MD_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(MD_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MD_u_CoupledKinematics) + call MV_PackMesh(V, u%CoupledKinematics(DL%i1), ValAry) ! Mesh + case (MD_u_DeltaL) + VarVals = u%DeltaL(V%iLB:V%iUB) ! Rank 1 Array + case (MD_u_DeltaLdot) + VarVals = u%DeltaLdot(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine MD_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(MD_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call MD_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine MD_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(MD_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MD_u_CoupledKinematics) + call MV_UnpackMesh(V, ValAry, u%CoupledKinematics(DL%i1)) ! Mesh + case (MD_u_DeltaL) + u%DeltaL(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MD_u_DeltaLdot) + u%DeltaLdot(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function MD_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (MD_u_CoupledKinematics) + Name = "u%CoupledKinematics("//trim(Num2LStr(DL%i1))//")" + case (MD_u_DeltaL) + Name = "u%DeltaL" + case (MD_u_DeltaLdot) + Name = "u%DeltaLdot" + case default + Name = "Unknown Field" + end select +end function + +subroutine MD_VarsPackOutput(Vars, y, ValAry) + type(MD_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call MD_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine MD_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(MD_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MD_y_CoupledLoads) + call MV_PackMesh(V, y%CoupledLoads(DL%i1), ValAry) ! Mesh + case (MD_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case (MD_y_VisLinesMesh) + call MV_PackMesh(V, y%VisLinesMesh(DL%i1), ValAry) ! Mesh + case (MD_y_VisRodsMesh) + call MV_PackMesh(V, y%VisRodsMesh(DL%i1), ValAry) ! Mesh + case (MD_y_VisBodiesMesh) + call MV_PackMesh(V, y%VisBodiesMesh(DL%i1), ValAry) ! Mesh + case (MD_y_VisAnchsMesh) + call MV_PackMesh(V, y%VisAnchsMesh(DL%i1), ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine MD_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(MD_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call MD_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine MD_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(MD_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (MD_y_CoupledLoads) + call MV_UnpackMesh(V, ValAry, y%CoupledLoads(DL%i1)) ! Mesh + case (MD_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (MD_y_VisLinesMesh) + call MV_UnpackMesh(V, ValAry, y%VisLinesMesh(DL%i1)) ! Mesh + case (MD_y_VisRodsMesh) + call MV_UnpackMesh(V, ValAry, y%VisRodsMesh(DL%i1)) ! Mesh + case (MD_y_VisBodiesMesh) + call MV_UnpackMesh(V, ValAry, y%VisBodiesMesh(DL%i1)) ! Mesh + case (MD_y_VisAnchsMesh) + call MV_UnpackMesh(V, ValAry, y%VisAnchsMesh(DL%i1)) ! Mesh + end select + end associate +end subroutine + +function MD_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (MD_y_CoupledLoads) + Name = "y%CoupledLoads("//trim(Num2LStr(DL%i1))//")" + case (MD_y_WriteOutput) + Name = "y%WriteOutput" + case (MD_y_VisLinesMesh) + Name = "y%VisLinesMesh("//trim(Num2LStr(DL%i1))//")" + case (MD_y_VisRodsMesh) + Name = "y%VisRodsMesh("//trim(Num2LStr(DL%i1))//")" + case (MD_y_VisBodiesMesh) + Name = "y%VisBodiesMesh("//trim(Num2LStr(DL%i1))//")" + case (MD_y_VisAnchsMesh) + Name = "y%VisAnchsMesh("//trim(Num2LStr(DL%i1))//")" + case default + Name = "Unknown Field" + end select +end function + END MODULE MoorDyn_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/CMakeLists.txt b/modules/nwtc-library/CMakeLists.txt index 4c1e05e892..67b0a7607b 100644 --- a/modules/nwtc-library/CMakeLists.txt +++ b/modules/nwtc-library/CMakeLists.txt @@ -68,6 +68,7 @@ set(NWTCLIBS_SOURCES src/NWTC_Base.f90 src/SingPrec.f90 src/ModReg.f90 + src/ModVar.f90 src/ModMesh.f90 src/ModMesh_Mapping.f90 diff --git a/modules/nwtc-library/src/ModMesh.f90 b/modules/nwtc-library/src/ModMesh.f90 index 5a34676be6..fbc67a7b1c 100644 --- a/modules/nwtc-library/src/ModMesh.f90 +++ b/modules/nwtc-library/src/ModMesh.f90 @@ -1170,10 +1170,12 @@ SUBROUTINE MeshCreate ( BlankMesh RETURN END IF - + ! Initialize element table DO i = 1, NELEMKINDS - BlankMesh%ElemTable(i)%nelem = 0 ; BlankMesh%ElemTable(i)%maxelem = 0 - NULLIFY(BlankMesh%ElemTable(i)%Elements ) + BlankMesh%ElemTable(i)%nelem = 0 + BlankMesh%ElemTable(i)%maxelem = 0 + BlankMesh%ElemTable(i)%Xelement = 0 + NULLIFY(BlankMesh%ElemTable(i)%Elements) ENDDO ALLOCATE(BlankMesh%RemapFlag, Stat=ErrStat2 ) ! assign some space for this pointer to point to @@ -2743,7 +2745,7 @@ END SUBROUTINE PackLoadMesh_Names SUBROUTINE PackLoadMesh(M, Ary, indx_first) TYPE(MeshType) , INTENT(IN ) :: M !< Load mesh - REAL(ReKi) , INTENT(INOUT) :: Ary(:) !< array to pack this mesh into + REAL(R8Ki) , 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 ! local variables: @@ -2887,7 +2889,7 @@ END SUBROUTINE PackMotionMesh_Names SUBROUTINE PackMotionMesh(M, Ary, indx_first, FieldMask, TrimOP) TYPE(MeshType) , INTENT(IN ) :: M !< Motion mesh - REAL(ReKi) , INTENT(INOUT) :: Ary(:) !< array to pack this mesh into + REAL(R8Ki) , 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 ) :: TrimOP !< flag to determine if the orientation should be packed as a DCM or a log map diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 new file mode 100644 index 0000000000..516a386390 --- /dev/null +++ b/modules/nwtc-library/src/ModVar.f90 @@ -0,0 +1,1360 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2023 National Renewable Energy Laboratory +! +! This file is part of the NWTC Subroutine Library. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +!********************************************************************************************************************************** +!> The modules ModVar and ModVar_Types provide data structures and subroutines for representing and manipulating meshes +!! and meshed data in the FAST modular framework. +!! +!! Module variables provide a structured way for documenting, locating, and orchestrating the interdependencies between modules. +!! + +module ModVar +use NWTC_Library_Types +use NWTC_IO +use NWTC_Num +use ModMesh + +implicit none + +private +public :: MV_InitVarsJac +public :: MV_AddVar, MV_AddMeshVar +public :: MV_Perturb, MV_ComputeCentralDiff, MV_ComputeDiff, MV_ExtrapInterp, MV_AddDelta +public :: MV_HasFlagsAll, MV_HasFlagsAny, MV_SetFlags, MV_ClearFlags +public :: MV_NumVars, MV_NumVals, MV_FindVarDatLoc +public :: LoadFields, MotionFields, TransFields, AngularFields +public :: quat_to_dcm, dcm_to_quat, quat_inv, quat_to_rvec, rvec_to_quat, wm_to_quat, quat_to_wm, wm_inv, quat_compose +public :: MV_FieldString, MV_IsLoad, MV_IsMotion, IdxStr +public :: DumpMatrix, MV_AddModule +public :: MV_EqualDL +public :: MV_PackMesh, MV_UnpackMesh + +integer(IntKi), parameter :: LoadFields(*) = [FieldForce, FieldMoment] +integer(IntKi), parameter :: TransFields(*) = [FieldTransDisp, FieldTransVel, FieldTransAcc] +integer(IntKi), parameter :: AngularFields(*) = [FieldOrientation, FieldAngularVel, FieldAngularAcc, FieldAngularDisp] +integer(IntKi), parameter :: MotionFields(*) = [FieldTransDisp, FieldOrientation, FieldTransVel, & + FieldAngularVel, FieldTransAcc, FieldAngularAcc] + +logical, parameter :: UseSmallRotAngles = .false. + +contains + +subroutine MV_PackMesh(Var, Mesh, DstAry) + type(ModVarType), intent(in) :: Var + type(MeshType), intent(in) :: Mesh + real(R8Ki), intent(inout) :: DstAry(:) + integer(IntKi) :: i, j, k + select case (Var%Field) + case (FieldForce) + DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%Force, R8Ki), .true.) + case (FieldMoment) + DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%Moment, R8Ki), .true.) + case (FieldTransDisp) + DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%TranslationDisp, R8Ki), .true.) + case (FieldOrientation) + k = Var%iLoc(1) + do j = 1, Var%Nodes + DstAry(k:k + 2) = dcm_to_quat(Mesh%Orientation(:, :, j)) + k = k + 3 + end do + case (FieldTransVel) + DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%TranslationVel, R8Ki), .true.) + case (FieldAngularVel) + DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%RotationVel, R8Ki), .true.) + case (FieldTransAcc) + DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%TranslationAcc, R8Ki), .true.) + case (FieldAngularAcc) + DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%RotationAcc, R8Ki), .true.) + case (FieldScalar) + DstAry(Var%iLoc(1):Var%iLoc(2)) = pack(real(Mesh%Scalars, R8Ki), .true.) + end select +end subroutine + +subroutine MV_UnpackMesh(Var, SrcAry, Mesh) + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: SrcAry(:) + type(MeshType), intent(inout) :: Mesh + integer(IntKi) :: i, j, k + select case (Var%Field) + case (FieldForce) + Mesh%Force = reshape(SrcAry(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%Force)) + case (FieldMoment) + Mesh%Moment = reshape(SrcAry(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%Moment)) + case (FieldTransDisp) + Mesh%TranslationDisp = reshape(SrcAry(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%TranslationDisp)) + case (FieldOrientation) + k = Var%iLoc(1) + do j = 1, Var%Nodes + Mesh%Orientation(:, :, j) = quat_to_dcm(SrcAry(k:k + 2)) + k = k + 3 + end do + case (FieldTransVel) + Mesh%TranslationVel = reshape(SrcAry(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%TranslationVel)) + case (FieldAngularVel) + Mesh%RotationVel = reshape(SrcAry(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%RotationVel)) + case (FieldTransAcc) + Mesh%TranslationAcc = reshape(SrcAry(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%TranslationAcc)) + case (FieldAngularAcc) + Mesh%RotationAcc = reshape(SrcAry(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%RotationAcc)) + case (FieldScalar) + Mesh%Scalars = reshape(SrcAry(Var%iLoc(1):Var%iLoc(2)), shape(Mesh%Scalars)) + end select +end subroutine + +!------------------------------------------------------------------------------- +! Field Names +!------------------------------------------------------------------------------- + +function MV_FieldString(Field) result(str) + integer(IntKi), intent(in) :: Field + character(16) :: str + select case (Field) + case (FieldAngularAcc) + str = "AngularAcc" + case (FieldAngularDisp) + str = "AngularDisp" + case (FieldAngularVel) + str = "AngularVel" + case (FieldForce) + str = "Force" + case (FieldMoment) + str = "Moment" + case (FieldOrientation) + str = "Orientation" + case (FieldTransAcc) + str = "TransAcc" + case (FieldTransDisp) + str = "TransDisp" + case (FieldTransVel) + str = "TransVel" + case (FieldScalar) + str = "Scalar" + case default + str = "Unknown" + end select +end function + +subroutine MV_InitVarsJac(Vars, Jac, Linearize, ErrStat, ErrMsg) + type(ModVarsType), intent(inout) :: Vars + type(ModJacType), intent(inout) :: Jac + logical, intent(in) :: Linearize + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'MV_InitVarsJac' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, StartIndex + + ! Initialize error outputs + ErrStat = ErrID_None + ErrMsg = '' + + ! Initialize number of variables in each group + Vars%Nx = 0 + Vars%Nz = 0 + Vars%Nu = 0 + Vars%Ny = 0 + + ! Initialize continuous state variables + if (.not. allocated(Vars%x)) allocate (Vars%x(0)) + StartIndex = 1 + do i = 1, size(Vars%x) + call ModVarType_Init(Vars%x(i), StartIndex, Linearize, ErrStat2, ErrMsg2) + if (Failed()) return + end do + Vars%Nx = sum(Vars%x%Num) + Jac%Nx = Vars%Nx + + ! Initialize constraint state variables + if (.not. allocated(Vars%z)) allocate (Vars%z(0)) + StartIndex = 1 + do i = 1, size(Vars%z) + call ModVarType_Init(Vars%z(i), StartIndex, Linearize, ErrStat2, ErrMsg2) + if (Failed()) return + end do + Vars%Nz = sum(Vars%z%Num) + Jac%Nz = Vars%Nz + + ! Initialize input variables + if (.not. allocated(Vars%u)) allocate (Vars%u(0)) + StartIndex = 1 + do i = 1, size(Vars%u) + call ModVarType_Init(Vars%u(i), StartIndex, Linearize, ErrStat2, ErrMsg2) + if (Failed()) return + end do + Vars%Nu = sum(Vars%u%Num) + Jac%Nu = Vars%Nu + + ! Initialize output variables + if (.not. allocated(Vars%y)) allocate (Vars%y(0)) + StartIndex = 1 + do i = 1, size(Vars%y) + call ModVarType_Init(Vars%y(i), StartIndex, Linearize, ErrStat2, ErrMsg2) + if (Failed()) return + end do + Vars%Ny = sum(Vars%y%Num) + Jac%Ny = Vars%Ny + + ! Allocate Jacobian data arrays + ! if (Linearize) then + if (Jac%Nx > 0) then + call AllocAry(Jac%x, Jac%Nx, "Lin%x", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%x_perturb, Jac%Nx, "Lin%x_perturb", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%x_pos, Jac%Nx, "Lin%x_pos", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%x_neg, Jac%Nx, "Lin%x_neg", ErrStat2, ErrMsg2); if (Failed()) return + end if + if (Jac%Nz > 0) then + call AllocAry(Jac%z, Jac%Nz, "Lin%z", ErrStat2, ErrMsg2); if (Failed()) return + end if + if (Jac%Nu > 0) then + call AllocAry(Jac%u, Jac%Nu, "Lin%u", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%u_perturb, Jac%Nu, "Lin%u_perturb", ErrStat2, ErrMsg2); if (Failed()) return + end if + if (Jac%Ny > 0) then + call AllocAry(Jac%y, Jac%Ny, "Lin%y", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%y_pos, Jac%Ny, "Lin%y_pos", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Jac%y_neg, Jac%Ny, "Lin%y_neg", ErrStat2, ErrMsg2); if (Failed()) return + end if + ! end if + +contains + + function Failed() + logical Failed + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function + + function FailedAlloc() + logical FailedAlloc + FailedAlloc = ErrStat2 /= 0 + if (FailedAlloc) call SetErrStat(ErrID_Fatal, 'error allocating Vals', ErrStat, ErrMsg, RoutineName) + end function + +end subroutine + +elemental function IsMesh(Var) result(r) + type(ModVarType), intent(in) :: Var + logical :: r + r = iand(Var%Flags, VF_Mesh) > 0 +end function + +subroutine ModVarType_Init(Var, Index, Linearize, ErrStat, ErrMsg) + type(ModVarType), intent(inout) :: Var + integer(IntKi), intent(inout) :: Index + logical, intent(in) :: Linearize + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'ModVarsType_Init' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j + character(1), parameter :: Comp(3) = ['X', 'Y', 'Z'] + character(*), parameter :: Fmt = '(A," ",A,", node",I0,", ",A)' + character(2) :: UnitDesc + + ! Initialize error outputs + ErrStat = ErrID_None + ErrMsg = '' + + !---------------------------------------------------------------------------- + ! Mesh + !---------------------------------------------------------------------------- + + ! If this variable belongs to a mesh + if (MV_HasFlagsAll(Var, VF_Mesh)) then + + ! Size is the number of nodes in a mesh + Var%Nodes = Var%Num + + ! Number of values + Var%Num = Var%Nodes*3 + + ! If linearization enabled + if (.true.) then + + ! Set unit description for line mesh + UnitDesc = '' + if (MV_HasFlagsAll(Var, VF_Line)) UnitDesc = "/m" + + ! Switch based on field number + select case (Var%Field) + case (FieldForce) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" force, node "//trim(num2lstr(i))//', N'//UnitDesc, j=1, 3), i=1, Var%Nodes)] + case (FieldMoment) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" moment, node "//trim(num2lstr(i))//', Nm'//UnitDesc, j=1, 3), i=1, Var%Nodes)] + case (FieldTransDisp) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation displacement, node "//trim(num2lstr(i))//', m', j=1, 3), i=1, Var%Nodes)] + case (FieldOrientation) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" orientation angle, node "//trim(num2lstr(i))//', rad', j=1, 3), i=1, Var%Nodes)] + case (FieldTransVel) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation velocity, node "//trim(num2lstr(i))//', m/s', j=1, 3), i=1, Var%Nodes)] + case (FieldAngularVel) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" rotation velocity, node "//trim(num2lstr(i))//', rad/s', j=1, 3), i=1, Var%Nodes)] + case (FieldTransAcc) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation acceleration, node "//trim(num2lstr(i))//', m/s^2', j=1, 3), i=1, Var%Nodes)] + case (FieldAngularAcc) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" rotation acceleration, node "//trim(num2lstr(i))//', rad/s^2', j=1, 3), i=1, Var%Nodes)] + case default + call SetErrStat(ErrID_Fatal, "Invalid mesh field type", ErrStat, ErrMsg, RoutineName) + return + end select + + end if + end if + + !---------------------------------------------------------------------------- + ! Linearization + !---------------------------------------------------------------------------- + + if (.true.) then + if (.not. allocated(Var%LinNames)) then + call SetErrStat(ErrID_Fatal, "LinNames not allocated for "//Var%Name, ErrStat, ErrMsg, RoutineName) + return + else if (size(Var%LinNames) < Var%Num) then + call SetErrStat(ErrID_Fatal, "insufficient LinNames given for "//Var%Name, ErrStat, ErrMsg, RoutineName) + return + else if (size(Var%LinNames) > Var%Num) then + call SetErrStat(ErrID_Fatal, "excessive LinNames given for "//Var%Name, ErrStat, ErrMsg, RoutineName) + return + end if + else + ! Deallocate linearization names if linearization is not enabled + if (allocated(Var%LinNames)) deallocate (Var%LinNames) + end if + + !---------------------------------------------------------------------------- + ! Indices + !---------------------------------------------------------------------------- + + ! Set start and end indices for local matrices + Var%iLoc = [index, index + Var%Num - 1] + + ! Update index based on variable size + index = index + Var%Num + +contains + function Failed() + logical :: Failed + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine MV_AddModule(ModDataAry, ModID, ModAbbr, Instance, ModDT, SolverDT, Vars, Linearize, ErrStat, ErrMsg) + type(ModDataType), allocatable, intent(inout) :: ModDataAry(:) + integer(IntKi), intent(in) :: ModID + character(*), intent(in) :: ModAbbr + integer(IntKi), intent(in) :: Instance + real(R8Ki), intent(in) :: ModDT + real(R8Ki), intent(in) :: SolverDT + type(ModVarsType), intent(in) :: Vars + logical, intent(in) :: Linearize + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'MV_AddModule' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + type(ModDataType) :: ModData + integer(IntKi) :: i, StartIndex + + ErrStat = ErrID_None + ErrMsg = '' + + ! Populate module information + if (allocated(ModDataAry)) then + ModData%iMod = size(ModDataAry) + 1 + else + ModData%iMod = 1 + end if + ModData%ID = ModID + ModData%Abbr = ModAbbr + ModData%Ins = Instance + ModData%DT = ModDT + call NWTC_Library_CopyModVarsType(Vars, ModData%Vars, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Calculate Module Sub-stepping + !---------------------------------------------------------------------------- + + ! If module time step is same as global time step, set substeps to 1 + if (EqualRealNos(ModData%DT, SolverDT)) then + ModData%SubSteps = 1 + else + ! If the module time step is greater than the global time step, set error + if (ModData%DT > SolverDT) then + call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & + " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & + "cannot be larger than FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & + ErrStat, ErrMsg, RoutineName) + return + end if + + ! Calculate the number of substeps + ModData%SubSteps = nint(SolverDT/ModData%DT) + + ! If the module DT is not an exact integer divisor of the global time step, set error + if (.not. EqualRealNos(SolverDT, ModData%DT*ModData%SubSteps)) then + call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & + " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & + "must be an integer divisor of the FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & + ErrStat, ErrMsg, RoutineName) + return + end if + end if + + !---------------------------------------------------------------------------- + ! Add module info to array + !---------------------------------------------------------------------------- + + if (.not. allocated(ModDataAry)) then + ModDataAry = [ModData] + else + ModDataAry = [ModDataAry, ModData] + end if + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine GetModuleOrder(ModDataAry, ModIDs, ModOrder) + type(ModDataType), intent(in) :: ModDataAry(:) !< Array of module data structures + integer(IntKi), intent(in) :: ModIDs(:) !< List of module IDs to keep in order + integer(IntKi), allocatable, intent(out) :: ModOrder(:) !< Module data indices in order of ModIDs + integer(IntKi), allocatable :: ModIDAry(:), indices(:) + integer(IntKi) :: i + + ! Create array 1 to size(Mod) representing the index of each module data + indices = [(i, i=1, size(ModDataAry))] + + ! Get array of module IDs from array of module data + ModIDAry = [(ModDataAry(i)%ID, i=1, size(ModDataAry))] + + ! Initialize module order array with no size + allocate (ModOrder(0)) + + ! Loop through module IDs to keep, add module data indices that match module ID to order array + do i = 1, size(ModIDs) + ModOrder = [ModOrder, pack(indices, ModIDAry == ModIDs(i))] + end do + +end subroutine + +!------------------------------------------------------------------------------- +! Functions for packing and unpacking data by variable +!------------------------------------------------------------------------------- + +subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry) + type(ModVarType), intent(in) :: Var + integer(IntKi), intent(in) :: iLin + integer(IntKi), intent(in) :: PerturbSign + real(R8Ki), intent(in) :: BaseAry(:) + real(R8Ki), intent(inout) :: PerturbAry(:) + + real(R8Ki) :: Perturb + real(R8Ki) :: quat(3), quat_p(3) + real(R8Ki) :: rv(3), dcm(3, 3) + integer(IntKi) :: i, j + integer(IntKi) :: ErrStat + character(ErrMsgLen) :: ErrMsg + + ! Copy base array to perturbed array + PerturbAry = BaseAry + + ! Get variable perturbation and combine with sign + Perturb = Var%Perturb*real(PerturbSign, R8Ki) + + ! Index of perturbation value in array + i = Var%iLoc(1) + iLin - 1 + + ! If variable field is orientation, perturbation is in radians + if (Var%Field == FieldOrientation) then + j = mod(iLin - 1, 3) ! component being modified (0, 1, 2) + i = i - j ! index of start of quaternion parameters (3) + quat = BaseAry(i:i + 2) ! Current quat parameters value + if (MV_HasFlagsAll(Var, VF_SmallAngle)) then + dcm = quat_to_dcm(quat) + rv = GetSmllRotAngs(dcm, ErrStat, ErrMsg) + rv(j + 1) = rv(j + 1) + Perturb + call SmllRotTrans('linearization perturbation', rv(1), rv(2), rv(3), dcm, ErrStat=ErrStat, ErrMsg=ErrMsg) + quat = dcm_to_quat(dcm) + else + quat_p = perturb_quat(Perturb, j + 1) ! Quaternion of perturbed angle + quat = quat_compose(quat, quat_p) ! Compose perturbation and current rotation + end if + PerturbAry(i:i + 2) = quat ! Save perturbed quaternion in array + else + PerturbAry(i) = PerturbAry(i) + Perturb ! Add perturbation directly + end if + +end subroutine + +subroutine MV_ComputeDiff(VarAry, PosAry, NegAry, DiffAry) + type(ModVarType), intent(in) :: VarAry(:) ! Array of variables + real(R8Ki), intent(in) :: PosAry(:) ! Positive result array + real(R8Ki), intent(in) :: NegAry(:) ! Negative result array + real(R8Ki), intent(inout) :: DiffAry(:) ! Array containing difference + integer(IntKi) :: i, j, k + real(R8Ki) :: delta(3), R(3, 3), quat_pos(3), quat_neg(3) + real(R8Ki) :: ang_pos(3), ang_neg(3) + integer(IntKi) :: ErrStat + character(ErrMsgLen) :: ErrMsg + + ! Loop through variables + do i = 1, size(VarAry) + + ! If variable field is orientation + if (VarAry(i)%Field == FieldOrientation) then + + ! Starting index into arrays + k = VarAry(i)%iLoc(1) + + ! Loop through nodes + do j = 1, VarAry(i)%Nodes + + ! Quaternions from negative and positive perturbations + quat_neg = NegAry(k:k + 2) + quat_pos = PosAry(k:k + 2) + + ! If flag set to use small angle rotations + if (UseSmallRotAngles) then + + ! If variable has flag to use small angles when computing difference + if (MV_HasFlagsAll(VarAry(i), VF_SmallAngle)) then + + ang_pos = GetSmllRotAngs(quat_to_dcm(quat_pos), ErrStat, ErrMsg) + ang_neg = GetSmllRotAngs(quat_to_dcm(quat_neg), ErrStat, ErrMsg) + + DiffAry(k:k + 2) = ang_pos - ang_neg + else + + ! Calculate relative rotation from negative to positive perturbation + delta = quat_compose(-quat_neg, quat_pos) + + ! Convert relative rotation from quaternion to rotation vector + DiffAry(k:k + 2) = GetSmllRotAngs(quat_to_dcm(delta), ErrStat, ErrMsg) + end if + + else + + ! Calculate relative rotation from negative to positive perturbation + delta = quat_compose(-quat_neg, quat_pos) + + ! Convert delta quaternion to rotation vector and store in diff array + DiffAry(k:k + 2) = quat_to_rvec(delta) + + end if + + ! Increment starting index + k = k + 3 + + end do + + else + + ! Subtract negative array from positive array + associate (iLoc => VarAry(i)%iLoc) + DiffAry(iLoc(1):iLoc(2)) = PosAry(iLoc(1):iLoc(2)) - NegAry(iLoc(1):iLoc(2)) + end associate + end if + end do +end subroutine + +subroutine MV_ComputeCentralDiff(VarAry, Delta, PosAry, NegAry, DerivAry) + type(ModVarType), intent(in) :: VarAry(:) ! Array of variables + real(R8Ki), intent(in) :: Delta ! Positive perturbation value + real(R8Ki), intent(in) :: PosAry(:) ! Positive perturbation result array + real(R8Ki), intent(in) :: NegAry(:) ! Negative perturbation result array + real(R8Ki), intent(inout) :: DerivAry(:) ! Array containing derivative + + ! Compute difference between all values + call MV_ComputeDiff(VarAry, PosAry, NegAry, DerivAry) + + ! Divide derivative array by twice delta + DerivAry = DerivAry/(2.0_R8Ki*Delta) + +end subroutine + +!> MV_ExtrapInterp interpolates arrays of variable data to the target x value from +!! the array of x values. Supports constant, linear, and quadratic interpolation +!! similar to the ExtrapInterp routines created by the registry. +subroutine MV_ExtrapInterp(VarAry, y, tin, y_out, tin_out, ErrStat, ErrMsg) + type(ModVarType), intent(in) :: VarAry(:) ! Array of variables + real(R8Ki), intent(in) :: y(:, :) + real(R8Ki), intent(in) :: tin(:) + real(R8Ki), intent(inout) :: y_out(:) + real(R8Ki), intent(in) :: tin_out + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'MV_ExtrapInterp' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: InterpOrder + real(R8Ki) :: t(3), t_out, a1, a2, a3 + real(R8Ki) :: q1(4), q2(4), q3(4), q(4) + integer(IntKi) :: i, j, k + + ErrStat = ErrID_None + ErrMsg = '' + + ! Check that array sizes match + if (size(tin) /= size(y, 2)) then + call SetErrStat(ErrID_Fatal, 'size(tin) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + end if + + ! Calculate interpolation order + InterpOrder = size(tin) - 1 + + ! Switch based on interpolation order + select case (InterpOrder) + + case (0) ! Constant interpolation (copy) + + y_out = y(:, 1) + + case (1) ! Linear Interpolation + + t(1:2) = tin - tin(1) + t_out = tin_out - tin(1) + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + y_out = a1*y(:, 1) + a2*y(:, 2) + + ! Loop through glue output variables + do i = 1, size(VarAry) + + ! Switch based on variable field type + select case (VarAry(i)%Field) + + case (FieldOrientation) ! SLERP for orientation quaternions + + k = VarAry(i)%iLoc(1) + do j = 1, VarAry(i)%Nodes + + ! Get quaternion 1 from array, calculate scalar + q1(2:4) = y(k:k + 2, 1) + q1(1) = quat_scalar(q1(2:4)) + + ! Get quaternion 2 from array, calculate scalar + q2(2:4) = y(k:k + 2, 2) + q2(1) = quat_scalar(q2(2:4)) + + ! Calculate dot product of two quaternions + ! Make quaternion 2 consistent with quaternion 1 for interp + if (dot_product(q1, q2) < 0.0_R8Ki) q2 = -q2 + + ! Interpolate quaternion components + q = a1*q1 + a2*q2 + + ! Store canonical quaternion in output array + y_out(k:k + 2) = quat_canonical(q(1), q(2:4)) + + ! Increment quaternion index + k = k + 3 + end do + + case (FieldScalar) ! Scalar field + + ! If field is on the range [0,2PI], perform angular interp + if (MV_HasFlagsAll(VarAry(i), VF_2PI)) then + + k = VarAry(i)%iLoc(1) + do j = 1, VarAry(i)%Num + call Angles_ExtrapInterp(y(k, 1), y(k, 2), t(1:2), y_out(k), t_out) + k = k + 1 + end do + + end if + + end select + + end do + + case (2) ! Quadratic Interpolation + + t = tin - tin(1) + t_out = tin_out - tin(1) + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + y_out = a1*y(:, 1) + a2*y(:, 2) + a3*y(:, 3) + + ! Loop through glue output variables + do i = 1, size(VarAry) + + ! Switch based on variable field type + select case (VarAry(i)%Field) + + case (FieldOrientation) ! SLERP for orientation quaternions + + k = VarAry(i)%iLoc(1) + do j = 1, VarAry(i)%Nodes + + ! Get quaternion 1 from array, calculate scalar + q1(2:4) = y(k:k + 2, 1) + q1(1) = quat_scalar(q1(2:4)) + + ! Get quaternion 2 from array, calculate scalar + q2(2:4) = y(k:k + 2, 2) + q2(1) = quat_scalar(q2(2:4)) + + ! Get quaternion 3 from array, calculate scalar + q3(2:4) = y(k:k + 2, 3) + q3(1) = quat_scalar(q2(2:4)) + + ! Make quaternions 2 and 3 consistent with quaternion 1 + if (dot_product(q1, q2) < 0.0_R8Ki) q2 = -q2 + if (dot_product(q1, q3) < 0.0_R8Ki) q3 = -q3 + + ! Interpolate quaternion components + q = a1*q1 + a2*q2 + a3*q3 + + ! Store canonical quaternion in output array + y_out(k:k + 2) = quat_canonical(q(1), q(2:4)) + + ! Increment quaternion index + k = k + 3 + end do + + case (FieldScalar) ! Scalar field + + ! If field is on the range [0,2PI], perform angular interp + if (MV_HasFlagsAll(VarAry(i), VF_2PI)) then + + k = VarAry(i)%iLoc(1) + do j = 1, VarAry(i)%Num + call Angles_ExtrapInterp(y(k, 1), y(k, 2), y(k, 3), t, y_out(k), t_out) + k = k + 1 + end do + + end if + + end select + + end do + + case default + + ! Unsupported Interpolation + call SetErrStat(ErrID_Fatal, 'size(t) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select + +end subroutine + +subroutine MV_AddDelta(VarAry, DeltaAry, DataAry) + type(ModVarType), intent(in) :: VarAry(:) ! Array of variables + real(R8Ki), intent(in) :: DeltaAry(:) ! Array of delta values + real(R8Ki), intent(inout) :: DataAry(:) ! Array to be modified + integer(IntKi) :: i, j, k + real(R8Ki) :: quat_base(3), quat_delta(3), rvec(3), dcm(3, 3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ! Loop through variables + do i = 1, size(VarAry) + associate (iLoc => VarAry(i)%iLoc) + select case (VarAry(i)%Field) + case (FieldOrientation) + + ! Starting index into arrays + k = iLoc(1) + + ! Loop through nodes + do j = 1, VarAry(i)%Nodes + + ! Quaternion from data array + quat_base = DataAry(k:k + 2) + + ! Get rotation vector delta + rvec = DeltaAry(k:k + 2) + + if (UseSmallRotAngles) then + call SmllRotTrans('linearization perturbation', rvec(1), rvec(2), rvec(3), dcm, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + quat_delta = dcm_to_quat(dcm) + else + quat_delta = rvec_to_quat(rvec) + end if + + ! Calculate composition of base quaternion and delta quaternion + DataAry(k:k + 2) = quat_compose(quat_base, quat_delta) + + ! Increment starting index + k = k + 3 + end do + + case default + DataAry(iLoc(1):iLoc(2)) = DataAry(iLoc(1):iLoc(2)) + DeltaAry(iLoc(1):iLoc(2)) + end select + end associate + end do +end subroutine + +!------------------------------------------------------------------------------- +! Functions for adding Variables +!------------------------------------------------------------------------------- + +subroutine MV_AddMeshVar(VarAry, Name, Fields, DL, Mesh, Flags, Perturbs, Active, iVar) + type(ModVarType), allocatable, intent(inout) :: VarAry(:) + character(*), intent(in) :: Name + integer(IntKi), intent(in) :: Fields(:) + type(DatLoc), intent(in) :: DL + type(MeshType), intent(inout) :: Mesh + integer(IntKi), optional, intent(in) :: Flags + real(R8Ki), optional, intent(in) :: Perturbs(:) + logical, optional, intent(in) :: Active + integer(IntKi) :: FlagsLocal + logical :: ActiveLocal + real(R8Ki), allocatable :: PerturbsLocal(:) + integer(IntKi), optional, intent(out) :: iVar + integer(IntKi) :: i + + ! If variable index is present, initialize to zero in case variable is inactive + if (present(iVar)) iVar = 0 + + ! If active argument specified and not active, return + if (present(Active)) then + if (.not. Active) return + end if + + ! If mesh has not been committed, return + if (.not. Mesh%committed) return + + ! Set mesh ID + if (allocated(VarAry)) then + Mesh%ID = size(VarAry) + 1 + else + Mesh%ID = 1 + end if + + ! Save variable index + if (present(iVar)) iVar = Mesh%ID + + ! Apply flags if specified + FlagsLocal = VF_Mesh + if (present(Flags)) FlagsLocal = ior(FlagsLocal, Flags) + + ! Set perturbations if specified + PerturbsLocal = [(0.0_R8Ki, i=1, size(Fields))] + if (present(Perturbs)) PerturbsLocal = Perturbs + + ! Loop through fields in mesh + do i = 1, size(Fields) + + ! Skip fields that mesh doesn't contain + if (.not. Mesh%fieldmask(Fields(i))) cycle + + ! Add variable + call MV_AddVar(VarAry, Name, Fields(i), & + DL=DL, & + Num=Mesh%Nnodes, & + Flags=FlagsLocal, & + Perturb=PerturbsLocal(i)) + end do +end subroutine + +subroutine MV_AddVar(VarAry, Name, Field, DL, Num, iAry, jAry, kAry, Flags, DerivOrder, Perturb, LinNames, Active) + type(ModVarType), allocatable, intent(inout) :: VarAry(:) + character(*), intent(in) :: Name + integer(IntKi), intent(in) :: Field + type(DatLoc), intent(in) :: DL + integer(IntKi), optional, intent(in) :: iAry, jAry, kAry + integer(IntKi), optional, intent(in) :: Num, Flags + real(R8Ki), optional, intent(in) :: Perturb + integer(IntKi), optional, intent(in) :: DerivOrder + character(*), optional, intent(in) :: LinNames(:) + logical, optional, intent(in) :: Active + integer(IntKi) :: i + type(ModVarType) :: Var + + ! If active argument specified and not active, return + if (present(Active)) then + if (.not. Active) return + end if + + ! Initialize var with default values + Var = ModVarType(Name=Name, Field=Field, DL=DL, Num=1) + + ! If number of values is zero, return + if (present(Num)) then + if (Num == 0) return + Var%Num = Num + end if + + ! Set optional values + if (present(Flags)) Var%Flags = Flags + if (present(iAry)) then + Var%iLB = iAry + Var%iUB = iAry + Var%Num - 1 + else + Var%iLB = 1 + Var%iUB = Var%Num + end if + if (present(jAry)) Var%j = jAry + if (present(kAry)) Var%k = kAry + if (present(Perturb)) Var%Perturb = Perturb + if (present(LinNames)) then + allocate (Var%LinNames(size(LinNames))) + do i = 1, size(LinNames) + Var%LinNames(i) = LinNames(i) + end do + end if + + ! Set Derivative Order + if (present(DerivOrder)) then + Var%DerivOrder = DerivOrder + else + select case (Var%Field) + case (FieldOrientation, FieldTransDisp, FieldAngularDisp) ! Position/displacement + Var%DerivOrder = 0 + case (FieldTransVel, FieldAngularVel) ! Velocity + Var%DerivOrder = 1 + case (FieldTransAcc, FieldAngularAcc) ! Acceleration + Var%DerivOrder = 2 + case default + Var%DerivOrder = -1 + end select + end if + + ! Append Var to VarArray + if (allocated(VarAry)) then + VarAry = [VarAry, Var] + else + VarAry = [Var] + end if + +end subroutine + +pure function MV_NumVals(VarAry, FlagFilter) result(Num) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), optional, intent(in) :: FlagFilter + integer(IntKi) :: Num, i + if (present(FlagFilter)) then + Num = 0 + do i = 1, size(VarAry) + if (MV_HasFlagsAll(VarAry(i), FlagFilter)) Num = Num + VarAry(i)%Num + end do + else + Num = sum(VarAry%Num) + end if +end function + +pure function MV_NumVars(VarAry, FlagFilter) result(Num) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), optional, intent(in) :: FlagFilter + integer(IntKi) :: Num, i + if (present(FlagFilter)) then + Num = 0 + do i = 1, size(VarAry) + if (MV_HasFlagsAll(VarAry(i), FlagFilter)) Num = Num + 1 + end do + else + Num = size(VarAry) + end if +end function + +! MV_IsLoad returns true if the variable field is FieldForce or FieldMoment +pure logical function MV_IsLoad(Var) + type(ModVarType), intent(in) :: Var + select case (Var%Field) + case (FieldForce, FieldMoment) + MV_IsLoad = .true. + case default + MV_IsLoad = .false. + end select +end function + +! MV_IsMotion returns true if the variable field is a motion +pure logical function MV_IsMotion(Var) + type(ModVarType), intent(in) :: Var + select case (Var%Field) + case (FieldTransDisp, FieldOrientation, FieldTransVel, FieldAngularVel, FieldTransAcc, FieldAngularAcc) + MV_IsMotion = .true. + case default + MV_IsMotion = .false. + end select +end function + +! MV_EqualDL returns true if data location numbers are greater than zero and +! all components of the data location are the same. +pure logical function MV_EqualDL(DL1, DL2) + type(DatLoc), intent(in) :: DL1, DL2 + MV_EqualDL = DL1%Num /= 0 .and. DL2%Num /= 0 .and. & + DL1%Num == DL2%Num .and. & + DL1%i1 == DL2%i1 .and. & + DL1%i2 == DL2%i2 .and. & + DL1%i3 == DL2%i3 +end function + +! Find variable index in array based on DatLoc number +pure function MV_FindVarDatLoc(VarAry, DL) result(iVar) + type(ModVarType), intent(in) :: VarAry(:) + type(DatLoc), intent(in) :: DL + integer(IntKi) :: iVar + do iVar = 1, size(VarAry) + if (VarAry(iVar)%DL%Num /= DL%Num) cycle + if (VarAry(iVar)%DL%i1 /= DL%i1) cycle + if (VarAry(iVar)%DL%i2 /= DL%i2) cycle + if (VarAry(iVar)%DL%i3 /= DL%i3) cycle + return + end do + iVar = 0 +end function + +!------------------------------------------------------------------------------- +! Flag Utilities +!------------------------------------------------------------------------------- + +!> MV_HasFlagsAll returns true if Flags is VF_None or variable contains all flags in Flags. +pure logical function MV_HasFlagsAll(Var, Flags) + type(ModVarType), intent(in) :: Var + integer(IntKi), intent(in) :: Flags + MV_HasFlagsAll = iand(Var%Flags, Flags) == Flags +end function + +!> MV_HasFlagsAny returns true if Flags is VF_None or variable contains any flags in Flags. +pure logical function MV_HasFlagsAny(Var, Flags) + type(ModVarType), intent(in) :: Var + integer(IntKi), intent(in) :: Flags + MV_HasFlagsAny = (Flags == VF_None) .or. (iand(Var%Flags, Flags) > 0) +end function + +!> MV_SetFlags adds the given flags to the variable. +subroutine MV_SetFlags(Var, Flags) + type(ModVarType), intent(inout) :: Var + integer(IntKi), intent(in) :: Flags + integer(IntKi) :: i + Var%Flags = ior(Var%Flags, Flags) +end subroutine + +!> MV_ClearFlags removes the given flags from the variable. +subroutine MV_ClearFlags(Var, Flags) + type(ModVarType), intent(inout) :: Var + integer(IntKi), intent(in) :: Flags + integer(IntKi) :: i + Var%Flags = iand(Var%Flags, not(Flags)) +end subroutine + +!------------------------------------------------------------------------------- +! String Utilities +!------------------------------------------------------------------------------- + +function IdxStr(i1, i2, i3, i4, i5) result(s) + integer(IntKi), intent(in) :: i1 + integer(IntKi), optional, intent(in) :: i2, i3, i4, i5 + character(100) :: s + if (present(i5)) then + s = '('//trim(Num2LStr(i1))//','//trim(Num2LStr(i2))//','//trim(Num2LStr(i3))//','//trim(Num2LStr(i4))//','//trim(Num2LStr(i5))//')' + else if (present(i4)) then + s = '('//trim(Num2LStr(i1))//','//trim(Num2LStr(i2))//','//trim(Num2LStr(i3))//','//trim(Num2LStr(i4))//')' + else if (present(i3)) then + s = '('//trim(Num2LStr(i1))//','//trim(Num2LStr(i2))//','//trim(Num2LStr(i3))//')' + else if (present(i2)) then + s = '('//trim(Num2LStr(i1))//','//trim(Num2LStr(i2))//')' + else + s = '('//trim(Num2LStr(i1))//')' + end if +end function + +!------------------------------------------------------------------------------- +! Rotation Utilities +!------------------------------------------------------------------------------- + +function perturb_quat(theta, idir) result(q) + real(R8Ki), intent(in) :: theta + integer(IntKi), intent(in) :: idir + real(R8Ki) :: rvec(3), q(3), dcm(3, 3) + integer(IntKi) :: ErrStat + character(ErrMsgLen) :: ErrMsg + + select case (idir) + case (1) + rvec = [theta, 0.0_R8Ki, 0.0_R8Ki] + case (2) + rvec = [0.0_R8Ki, theta, 0.0_R8Ki] + case (3) + rvec = [0.0_R8Ki, 0.0_R8Ki, theta] + end select + + if (UseSmallRotAngles) then + call SmllRotTrans('linearization perturbation', rvec(1), rvec(2), rvec(3), dcm, ErrStat=ErrStat, ErrMsg=ErrMsg) + q = dcm_to_quat(dcm) + else + q = rvec_to_quat(rvec) + end if +end function + +! quat_scalar returns the scalar part of the quaternion +pure function quat_scalar(q) result(w) + real(R8Ki), intent(in) :: q(3) + real(R8Ki) :: im, w + ! Calculate magnitude of imaginary part of quaternion + im = dot_product(q, q) + if (im < 1.0_R8Ki) then + w = sqrt(1.0_R8Ki - im) + else + w = 0.0_R8Ki + end if +end function + +! quat_canonical returns the imaginary part of the quaternion after ensuring +! that it's a unit quaternion with a positive real part. +pure function quat_canonical(q0, q) result(qc) + real(R8Ki), intent(in) :: q0, q(3) + real(R8Ki) :: qc(3), m + integer(IntKi) :: i + m = q0*q0 + q(1)*q(1) + q(2)*q(2) + q(3)*q(3) + if (q0 < 0.0_R8Ki) then + qc = -q/m + else + qc = q/m + end if +end function + +function dcm_to_quat(dcm) result(q) + real(R8Ki), intent(in) :: dcm(3, 3) + real(R8Ki) :: q(3) + real(R8Ki) :: t, s, qw + + ! Trace of matrix + t = dcm(1, 1) + dcm(2, 2) + dcm(3, 3) + + if (t > 0.0_R8Ki) then + S = sqrt(t + 1.0_R8Ki)*2.0_R8Ki ! S=4*qw + qw = 0.25_R8Ki*S + q(1) = (dcm(3, 2) - dcm(2, 3))/S + q(2) = (dcm(1, 3) - dcm(3, 1))/S + q(3) = (dcm(2, 1) - dcm(1, 2))/S + elseif ((dcm(1, 1) > dcm(2, 2)) .and. (dcm(1, 1) > dcm(3, 3))) then + S = sqrt(1.0_R8Ki + dcm(1, 1) - dcm(2, 2) - dcm(3, 3))*2.0_R8Ki ! S=4*qx + qw = (dcm(3, 2) - dcm(2, 3))/S + q(1) = 0.25_R8Ki*S + q(2) = (dcm(1, 2) + dcm(2, 1))/S + q(3) = (dcm(1, 3) + dcm(3, 1))/S + elseif (dcm(2, 2) > dcm(3, 3)) then + S = sqrt(1.0_R8Ki + dcm(2, 2) - dcm(1, 1) - dcm(3, 3))*2.0_R8Ki ! S=4*qy + qw = (dcm(1, 3) - dcm(3, 1))/S + q(1) = (dcm(1, 2) + dcm(2, 1))/S + q(2) = 0.25_R8Ki*S + q(3) = (dcm(2, 3) + dcm(3, 2))/S + else + S = sqrt(1.0_R8Ki + dcm(3, 3) - dcm(1, 1) - dcm(2, 2))*2.0_R8Ki ! S=4*qz + qw = (dcm(2, 1) - dcm(1, 2))/S + q(1) = (dcm(1, 3) + dcm(3, 1))/S + q(2) = (dcm(2, 3) + dcm(3, 2))/S + q(3) = 0.25_R8Ki*S + end if + + q = quat_canonical(qw, q) +end function + +! dcm_to_quat2 returns a quaternion from a DCM based on eigenanalysis +! https://en.wikipedia.org/wiki/Rotation_matrix#Quaternion +function dcm_to_quat2(dcm) result(q) + real(R8Ki), intent(in) :: dcm(3, 3) + real(R8Ki) :: q(3) + integer(IntKi), parameter :: n = 4 + real(R8Ki) :: Qxx, Qxy, Qxz, Qyx, Qyy, Qyz, Qzx, Qzy, Qzz + real(R8Ki) :: A(n, n), wr(n), wi(n), vl(n, n), vr(n, n), work(4*n) + integer(IntKi) :: info, lwork, i + + Qxx = dcm(1, 1) + Qyx = dcm(2, 1) + Qzx = dcm(3, 1) + Qxy = dcm(1, 2) + Qyy = dcm(2, 2) + Qzy = dcm(3, 2) + Qxz = dcm(1, 3) + Qyz = dcm(2, 3) + Qzz = dcm(3, 3) + + A(:, 1) = [Qxx - Qyy - Qzz, Qyx + Qxy, Qzx + Qxz, Qzy - Qyz]/3.0_R8Ki + A(:, 2) = [Qyx + Qxy, Qyy - Qxx - Qzz, Qzy + Qyz, Qxz - Qzx]/3.0_R8Ki + A(:, 3) = [Qzx + Qxz, Qzy + Qyz, Qzz - Qxx - Qyy, Qyx - Qxy]/3.0_R8Ki + A(:, 4) = [Qzy - Qyz, Qxz - Qzx, Qyx - Qxy, Qxx + Qyy + Qzz]/3.0_R8Ki + + lwork = 4*n + + call dgeev('N', 'V', n, A, n, wr, wi, vl, n, vr, n, work, lwork, info) + + ! If error calculating eigenvector/eigenvalues + if (info /= 0) then + q = 0.0_R8Ki + return + end if + + ! Get index of maximum real eigenvalue + i = maxloc(wr, dim=1) + + ! Canonical form of quaternion + q = quat_canonical(vr(4, i), vr(1:3, i)) +end function + +! quat_to_dcm returns a dcm based on the quaternion where q is a unit quaternion with a positive scalar component +! https://en.wikipedia.org/wiki/Quaternions_and_spatial_rotation#Quaternion-derived_rotation_matrix +pure function quat_to_dcm(q) result(dcm) + real(R8Ki), intent(in) :: q(3) + real(R8Ki) :: dcm(3, 3) + real(R8Ki) :: w, ww, xx, yy, zz, n, s + real(R8Ki) :: xy, yz, xz, wx, wy, wz + + ! Calculate scalar component + w = quat_scalar(q) + + ww = w*w + xx = q(1)*q(1) + yy = q(2)*q(2) + zz = q(3)*q(3) + + xy = q(1)*q(2) + yz = q(2)*q(3) + xz = q(1)*q(3) + + wx = q(1)*w + wy = q(2)*w + wz = q(3)*w + + n = ww + xx + yy + zz + if (n < epsilon(n)) then + s = 0.0_R8Ki + else + s = 2.0_R8Ki/n + end if + + dcm(:, 1) = [1.0_R8Ki - s*(yy + zz), s*(xy + wz), s*(xz - wy)] + dcm(:, 2) = [s*(xy - wz), 1.0_R8Ki - s*(xx + zz), s*(yz + wx)] + dcm(:, 3) = [s*(xz + wy), s*(yz - wx), 1.0_R8Ki - s*(xx + yy)] + +end function + +pure function quat_compose(q1, q2) result(q) + real(R8Ki), intent(in) :: q1(3), q2(3) + real(R8Ki) :: q(3), q0 + real(R8Ki) :: w1, x1, y1, z1 + real(R8Ki) :: w2, x2, y2, z2 + w1 = quat_scalar(q1) + x1 = q1(1); y1 = q1(2); z1 = q1(3) + w2 = quat_scalar(q2) + x2 = q2(1); y2 = q2(2); z2 = q2(3) + q0 = w1*w2 - x1*x2 - y1*y2 - z1*z2 + q(1) = w1*x2 + x1*w2 + y1*z2 - z1*y2 + q(2) = w1*y2 - x1*z2 + y1*w2 + z1*x2 + q(3) = w1*z2 + x1*y2 - y1*x2 + z1*w2 + q = quat_canonical(q0, q) +end function + +pure function quat_inv(q) result(qi) + real(R8Ki), intent(in) :: q(3) + real(R8Ki) :: qi(3) + qi = -q +end function + +! https://en.wikipedia.org/wiki/Quaternions_and_spatial_rotation#Recovering_the_axis-angle_representation +pure function quat_to_rvec(q) result(rvec) + real(R8Ki), intent(in) :: q(3) + real(R8Ki) :: qr, theta, tmp, rvec(3), m + + ! Magnitude of imaginary part + m = sqrt(dot_product(q, q)) + + ! If this is an identity quaternion, qr == 1, rotation vector is zero + if (m < epsilon(m)) then + rvec = 0.0_R8Ki + else + qr = sqrt(1.0_R8Ki - m*m) ! Scalar part + theta = 2.0_R8Ki*atan2(m, qr) ! Angle + rvec = -theta*q/m ! Negative sign doesn't make sense, but needed for quaternions + end if +end function + +pure function rvec_to_quat(rvec) result(q) + real(R8Ki), intent(in) :: rvec(3) + real(R8Ki) :: theta, half_theta, q0, q(3) + theta = sqrt(dot_product(rvec, rvec)) + if (theta < epsilon(theta)) then + ! Angle is zero, quaternion is identity + q = 0.0_R8Ki + else + half_theta = theta/2.0_R8Ki + q0 = cos(half_theta) + q = rvec/theta*sin(half_theta) + q = -quat_canonical(q0, q) ! Negative sign doesn't make sense, but needed for quaternions + end if +end function + +pure function wm_to_quat(c) result(q) + real(R8Ki), intent(in) :: c(3) + real(R8Ki) :: c0, q0, q(3) + c0 = 2.0_R8Ki - dot_product(c, c)/8.0_R8Ki + q0 = c0/(4.0_R8Ki - c0) + q = c/(4.0_R8Ki - c0) + q = quat_canonical(q0, q) +end function + +pure function quat_to_wm(q) result(c) + real(R8Ki), intent(in) :: q(3) + real(R8Ki) :: c(3) + real(R8Ki) :: q0 + q0 = quat_scalar(q) + c = 4.0_R8Ki*q/(1.0_R8Ki + q0) +end function + +pure function wm_inv(c) result(cinv) + real(R8Ki), intent(in) :: c(3) + real(R8Ki) :: cinv(3) + cinv = -c +end function + +pure function cross(a, b) result(c) + real(R8Ki), intent(in) :: a(3), b(3) + real(R8Ki) :: c(3) + c = [a(2)*b(3) - a(3)*b(2), a(3)*b(1) - a(1)*b(3), a(1)*b(2) - b(1)*a(2)] +end function + +!------------------------------------------------------------------------------- +! Debugging +!------------------------------------------------------------------------------- + +subroutine DumpMatrix(unit, filename, A, ErrStat, ErrMsg) + integer(IntKi), intent(in) :: unit + character(*), intent(in) :: filename + real(R8Ki), intent(in) :: A(:, :) + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'DumpMatrix' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + + call OpenBOutFile(unit, filename, ErrStat2, ErrMsg2) + write (unit) int(shape(A), B4Ki) + write (unit) pack(A, .true.) + close (unit) +end subroutine + +end module diff --git a/modules/nwtc-library/src/NWTC_Base.f90 b/modules/nwtc-library/src/NWTC_Base.f90 index 3cc5d1e65d..bedcf6183b 100644 --- a/modules/nwtc-library/src/NWTC_Base.f90 +++ b/modules/nwtc-library/src/NWTC_Base.f90 @@ -89,7 +89,7 @@ MODULE NWTC_Base !! and has the ability to provide a sort of traceback message of called !! routines (if this is called consistently). !! Modules in the FAST framework are recommended to use it. - subroutine SetErrStat (ErrStatLcl, ErrMessLcl, ErrStat, ErrMess, RoutineName) + pure subroutine SetErrStat (ErrStatLcl, ErrMessLcl, ErrStat, ErrMess, RoutineName) INTEGER(IntKi), INTENT(IN ) :: ErrStatLcl ! Error status of the operation CHARACTER(*), INTENT(IN ) :: ErrMessLcl ! Error message if ErrStat /= ErrID_None diff --git a/modules/nwtc-library/src/NWTC_Library.f90 b/modules/nwtc-library/src/NWTC_Library.f90 index e9c944c128..bd37a1ac85 100644 --- a/modules/nwtc-library/src/NWTC_Library.f90 +++ b/modules/nwtc-library/src/NWTC_Library.f90 @@ -78,6 +78,7 @@ MODULE NWTC_Library USE NWTC_Str ! String utils USE ModMesh USE ModReg + USE ModVar #ifndef NO_MESHMAPPING ! Note that ModMesh_Mapping also includes LAPACK routines diff --git a/modules/nwtc-library/src/NWTC_Library_IncSubs.f90 b/modules/nwtc-library/src/NWTC_Library_IncSubs.f90 index b289850916..6bddd1120e 100644 --- a/modules/nwtc-library/src/NWTC_Library_IncSubs.f90 +++ b/modules/nwtc-library/src/NWTC_Library_IncSubs.f90 @@ -574,4 +574,5 @@ subroutine NWTC_Library_UnPackMeshMapType(RF, OutData) call RegUnpackAlloc(RF, OutData%LoadLn2_M); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackMeshMapLinearizationType(RF, OutData%dM) ! dM end subroutine + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index 4ae45e08b4..3c010739bf 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -31,30 +31,41 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE NWTC_Library_Types !--------------------------------------------------------------------------------------------------------------------------------- +USE Precision USE SysSubs USE ModReg IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: VarNameLen = 64 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Force = 1 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Moment = 2 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Orientation = 3 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransDisp = 4 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularDisp = 5 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransVel = 6 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularVel = 7 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransAcc = 8 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularAcc = 9 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Scalar = 10 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_None = 0 ! Variable with no flags [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Mesh = 1 ! Variable contained in mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Line = 2 ! Variable is for a line mesh [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_RotFrame = 4 ! Variable in rotating frame [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Ext = 8 ! Variable for extended linearization [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Any = 4095 ! Enable all flags (used for filtering) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VC_None = 0 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Tight = 1 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Option1 = 2 ! [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Option2 = 3 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VarNameLen = 64 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldForce = 1 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldMoment = 2 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldOrientation = 3 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldTransDisp = 4 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldTransVel = 5 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldAngularVel = 6 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldTransAcc = 7 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldAngularAcc = 8 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldScalar = 9 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldAngularDisp = 10 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: FieldCount = 10 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_None = 0 ! Variable with no flags [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Mesh = 1 ! Variable contained in mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Line = 2 ! Variable is for a line mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_RotFrame = 4 ! Variable in rotating frame [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Linearize = 8 ! Variable for linearization [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_ExtLin = 16 ! Variable for extended linearization [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_SmallAngle = 32 ! Use small angles to calculate difference in linearization [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_2PI = 64 ! Variable is an angle with range [0,2pi] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_WM_Rot = 128 ! Variable is a Wiener-Milenkovic rotation [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_WriteOut = 256 ! Variable for write output [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Solve = 512 ! Variable for tight coupling solver [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AeroMap = 1024 ! Variable for aeromap [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_DerivOrder1 = 2048 ! Variable is derivative order 1 in linearization file [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_DerivOrder2 = 4096 ! Variable is derivative order 2 in linearization file [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Mapping = 8192 ! Variable is used in a module-to-module transfer mapping [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_None = 0 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Tight = 1 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Option1 = 2 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Option2 = 3 ! [-] ! ========= ProgDesc ======= TYPE, PUBLIC :: ProgDesc CHARACTER(99) :: Name !< Name of the program or module [-] @@ -106,74 +117,102 @@ MODULE NWTC_Library_Types CHARACTER(6) :: RNG_type END TYPE NWTC_RandomNumber_ParameterType ! ======================= +! ========= DatLoc ======= + TYPE, PUBLIC :: DatLoc + INTEGER(IntKi) :: Num = 0 !< Mesh number in module [-] + INTEGER(IntKi) :: i1 = 0 !< Index 1 [-] + INTEGER(IntKi) :: i2 = 0 !< Index 2 [-] + INTEGER(IntKi) :: i3 = 0 !< Index 3 [-] + INTEGER(IntKi) :: i4 = 0 !< Index 4 [-] + INTEGER(IntKi) :: i5 = 0 !< Index 5 [-] + END TYPE DatLoc +! ======================= ! ========= ModVarType ======= TYPE, PUBLIC :: ModVarType - character(VarNameLen) :: Name !< [-] INTEGER(IntKi) :: Field = 0 !< [-] INTEGER(IntKi) :: Nodes = 1 !< [-] INTEGER(IntKi) :: Num = 1 !< [-] INTEGER(IntKi) :: Flags = 0 !< [-] INTEGER(IntKi) :: DerivOrder = 0 !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iLoc !< indices in local arrays [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iSol !< indices in solver arrays [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iLin !< indices in linearization arrays [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iq !< row index in solver q matrix [-] - INTEGER(IntKi) , DIMENSION(1:2) :: iUsr = 0_IntKi !< first user defined index for variable, can be used a lower/upper bounds [-] - INTEGER(IntKi) :: jUsr = 0 !< second user defined index for variable [-] - INTEGER(IntKi) :: MeshID = 0 !< Mesh identification number [-] - LOGICAL :: Solve = .false. !< flag indicating that variable is used by solver [-] - REAL(R8Ki) :: Perturb = 0 !< perturbation [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iLoc = 0 !< indices in module arrays [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iGlu = 0 !< indices in module arrays [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iq = 0 !< solver state row indices [-] + INTEGER(IntKi) :: iLB = 0 !< first user defined index lower bound for variable [-] + INTEGER(IntKi) :: iUB = 0 !< first user defined index upper bound for variable [-] + INTEGER(IntKi) :: j = 0 !< second user defined index for variable [-] + INTEGER(IntKi) :: k = 0 !< third user defined index for variable [-] + INTEGER(IntKi) :: m = 0 !< fourth user defined index for variable [-] + INTEGER(IntKi) :: n = 0 !< fifth user defined index for variable [-] + REAL(R8Ki) :: Perturb = 0 !< perturbation amount for linearization [-] + TYPE(DatLoc) :: DL !< data location [-] + character(VarNameLen) :: Name !< [-] character(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames !< [-] END TYPE ModVarType ! ======================= ! ========= ModVarsType ======= TYPE, PUBLIC :: ModVarsType - INTEGER(IntKi) :: ModNum = 0 !< [-] - character(6) :: ModAbbr !< [-] + INTEGER(IntKi) :: Nx = 0 !< Number of x values [-] + INTEGER(IntKi) :: Nz = 0 !< Number of z values [-] + INTEGER(IntKi) :: Nu = 0 !< Number of u values [-] + INTEGER(IntKi) :: Ny = 0 !< Number of y values [-] TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: x !< Module state variable array [-] + TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: z !< Module state variable array [-] TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: u !< Module input variable array [-] TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: y !< Module output variable array [-] - INTEGER(IntKi) :: Nx = 0_IntKi !< [-] - INTEGER(IntKi) :: Nu = 0_IntKi !< [-] - INTEGER(IntKi) :: Ny = 0_IntKi !< [-] END TYPE ModVarsType ! ======================= -! ========= ModValsType ======= - TYPE, PUBLIC :: ModValsType +! ========= ModJacType ======= + TYPE, PUBLIC :: ModJacType + INTEGER(IntKi) :: Nx = 0 !< Number of x values [-] + INTEGER(IntKi) :: Nz = 0 !< Number of z values [-] + INTEGER(IntKi) :: Nu = 0 !< Number of u values [-] + INTEGER(IntKi) :: Ny = 0 !< Number of y values [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dxdt !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: z !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u_perturb !< input perturbation array [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_perturb !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xp !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xn !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: yp !< [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: yn !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: z_perturb !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u_perturb !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_pos !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_neg !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_pos !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_neg !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: StateRotation !< [-] + END TYPE ModJacType +! ======================= +! ========= ModLinType ======= + TYPE, PUBLIC :: ModLinType + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: z !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: J !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdx !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdx !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdu !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdu !< [-] - END TYPE ModValsType + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdy !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdy !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: StateRotation !< [-] + END TYPE ModLinType ! ======================= ! ========= ModDataType ======= TYPE, PUBLIC :: ModDataType - INTEGER(IntKi) :: Idx = 0 !< Module index in array of modules [-] - INTEGER(IntKi) :: ID = 0 !< Module identification number [-] character(ChanLen) :: Abbr !< Module name abbreviation [-] + INTEGER(IntKi) :: iMod = 0 !< Module index in array of modules [-] + INTEGER(IntKi) :: ID = 0 !< Module identification number [-] INTEGER(IntKi) :: Ins = 0 !< Module instance number [-] - LOGICAL :: IsTC = .false. !< Flag indicating module is part of tight coupling [-] - REAL(R8Ki) :: DT = 0 !< Module time step [-] INTEGER(IntKi) :: SubSteps = 0 !< Module number of substeps per solver time step [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ixs !< index array mapping local x vector to global x vector [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ius !< index array mapping local u vector to global u vector [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: iys !< index array mapping local y vector to global y vector [-] - TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Pointer to module variables type [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: SrcMaps !< Indices of mappings where module is the source [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DstMaps !< Indices of mappings where module is the destination [-] + REAL(R8Ki) :: DT = 0 !< Module time step [-] + TYPE(ModVarsType) :: Vars !< Module variables type [-] + TYPE(ModLinType) :: Lin !< Module linearization arrays and matrices [-] END TYPE ModDataType ! ======================= -CONTAINS + +contains subroutine NWTC_Library_CopyProgDesc(SrcProgDescData, DstProgDescData, CtrlCode, ErrStat, ErrMsg) type(ProgDesc), intent(in) :: SrcProgDescData @@ -593,6 +632,59 @@ subroutine NWTC_Library_UnPackNWTC_RandomNumber_ParameterType(RF, OutData) call RegUnpack(RF, OutData%RNG_type); if (RegCheckErr(RF, RoutineName)) return end subroutine +subroutine NWTC_Library_CopyDatLoc(SrcDatLocData, DstDatLocData, CtrlCode, ErrStat, ErrMsg) + type(DatLoc), intent(in) :: SrcDatLocData + type(DatLoc), intent(inout) :: DstDatLocData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_CopyDatLoc' + ErrStat = ErrID_None + ErrMsg = '' + DstDatLocData%Num = SrcDatLocData%Num + DstDatLocData%i1 = SrcDatLocData%i1 + DstDatLocData%i2 = SrcDatLocData%i2 + DstDatLocData%i3 = SrcDatLocData%i3 + DstDatLocData%i4 = SrcDatLocData%i4 + DstDatLocData%i5 = SrcDatLocData%i5 +end subroutine + +subroutine NWTC_Library_DestroyDatLoc(DatLocData, ErrStat, ErrMsg) + type(DatLoc), intent(inout) :: DatLocData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyDatLoc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine NWTC_Library_PackDatLoc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(DatLoc), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackDatLoc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Num) + call RegPack(RF, InData%i1) + call RegPack(RF, InData%i2) + call RegPack(RF, InData%i3) + call RegPack(RF, InData%i4) + call RegPack(RF, InData%i5) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackDatLoc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(DatLoc), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackDatLoc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Num); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%i1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%i2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%i3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%i4); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%i5); if (RegCheckErr(RF, RoutineName)) return +end subroutine + subroutine NWTC_Library_CopyModVarType(SrcModVarTypeData, DstModVarTypeData, CtrlCode, ErrStat, ErrMsg) type(ModVarType), intent(in) :: SrcModVarTypeData type(ModVarType), intent(inout) :: DstModVarTypeData @@ -601,68 +693,29 @@ subroutine NWTC_Library_CopyModVarType(SrcModVarTypeData, DstModVarTypeData, Ctr character(*), intent( out) :: ErrMsg integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyModVarType' ErrStat = ErrID_None ErrMsg = '' - DstModVarTypeData%Name = SrcModVarTypeData%Name DstModVarTypeData%Field = SrcModVarTypeData%Field DstModVarTypeData%Nodes = SrcModVarTypeData%Nodes DstModVarTypeData%Num = SrcModVarTypeData%Num DstModVarTypeData%Flags = SrcModVarTypeData%Flags DstModVarTypeData%DerivOrder = SrcModVarTypeData%DerivOrder - if (allocated(SrcModVarTypeData%iLoc)) then - LB(1:1) = lbound(SrcModVarTypeData%iLoc) - UB(1:1) = ubound(SrcModVarTypeData%iLoc) - if (.not. allocated(DstModVarTypeData%iLoc)) then - allocate(DstModVarTypeData%iLoc(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iLoc.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModVarTypeData%iLoc = SrcModVarTypeData%iLoc - end if - if (allocated(SrcModVarTypeData%iSol)) then - LB(1:1) = lbound(SrcModVarTypeData%iSol) - UB(1:1) = ubound(SrcModVarTypeData%iSol) - if (.not. allocated(DstModVarTypeData%iSol)) then - allocate(DstModVarTypeData%iSol(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iSol.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModVarTypeData%iSol = SrcModVarTypeData%iSol - end if - if (allocated(SrcModVarTypeData%iLin)) then - LB(1:1) = lbound(SrcModVarTypeData%iLin) - UB(1:1) = ubound(SrcModVarTypeData%iLin) - if (.not. allocated(DstModVarTypeData%iLin)) then - allocate(DstModVarTypeData%iLin(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iLin.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModVarTypeData%iLin = SrcModVarTypeData%iLin - end if - if (allocated(SrcModVarTypeData%iq)) then - LB(1:1) = lbound(SrcModVarTypeData%iq) - UB(1:1) = ubound(SrcModVarTypeData%iq) - if (.not. allocated(DstModVarTypeData%iq)) then - allocate(DstModVarTypeData%iq(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iq.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModVarTypeData%iq = SrcModVarTypeData%iq - end if - DstModVarTypeData%iUsr = SrcModVarTypeData%iUsr - DstModVarTypeData%jUsr = SrcModVarTypeData%jUsr - DstModVarTypeData%MeshID = SrcModVarTypeData%MeshID - DstModVarTypeData%Solve = SrcModVarTypeData%Solve + DstModVarTypeData%iLoc = SrcModVarTypeData%iLoc + DstModVarTypeData%iGlu = SrcModVarTypeData%iGlu + DstModVarTypeData%iq = SrcModVarTypeData%iq + DstModVarTypeData%iLB = SrcModVarTypeData%iLB + DstModVarTypeData%iUB = SrcModVarTypeData%iUB + DstModVarTypeData%j = SrcModVarTypeData%j + DstModVarTypeData%k = SrcModVarTypeData%k + DstModVarTypeData%m = SrcModVarTypeData%m + DstModVarTypeData%n = SrcModVarTypeData%n DstModVarTypeData%Perturb = SrcModVarTypeData%Perturb + call NWTC_Library_CopyDatLoc(SrcModVarTypeData%DL, DstModVarTypeData%DL, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstModVarTypeData%Name = SrcModVarTypeData%Name if (allocated(SrcModVarTypeData%LinNames)) then LB(1:1) = lbound(SrcModVarTypeData%LinNames) UB(1:1) = ubound(SrcModVarTypeData%LinNames) @@ -681,21 +734,13 @@ subroutine NWTC_Library_DestroyModVarType(ModVarTypeData, ErrStat, ErrMsg) type(ModVarType), intent(inout) :: ModVarTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModVarType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(ModVarTypeData%iLoc)) then - deallocate(ModVarTypeData%iLoc) - end if - if (allocated(ModVarTypeData%iSol)) then - deallocate(ModVarTypeData%iSol) - end if - if (allocated(ModVarTypeData%iLin)) then - deallocate(ModVarTypeData%iLin) - end if - if (allocated(ModVarTypeData%iq)) then - deallocate(ModVarTypeData%iq) - end if + call NWTC_Library_DestroyDatLoc(ModVarTypeData%DL, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModVarTypeData%LinNames)) then deallocate(ModVarTypeData%LinNames) end if @@ -706,21 +751,23 @@ subroutine NWTC_Library_PackModVarType(RF, Indata) type(ModVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackModVarType' if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%Name) call RegPack(RF, InData%Field) call RegPack(RF, InData%Nodes) call RegPack(RF, InData%Num) call RegPack(RF, InData%Flags) call RegPack(RF, InData%DerivOrder) - call RegPackAlloc(RF, InData%iLoc) - call RegPackAlloc(RF, InData%iSol) - call RegPackAlloc(RF, InData%iLin) - call RegPackAlloc(RF, InData%iq) - call RegPack(RF, InData%iUsr) - call RegPack(RF, InData%jUsr) - call RegPack(RF, InData%MeshID) - call RegPack(RF, InData%Solve) + call RegPack(RF, InData%iLoc) + call RegPack(RF, InData%iGlu) + call RegPack(RF, InData%iq) + call RegPack(RF, InData%iLB) + call RegPack(RF, InData%iUB) + call RegPack(RF, InData%j) + call RegPack(RF, InData%k) + call RegPack(RF, InData%m) + call RegPack(RF, InData%n) call RegPack(RF, InData%Perturb) + call NWTC_Library_PackDatLoc(RF, InData%DL) + call RegPack(RF, InData%Name) call RegPackAlloc(RF, InData%LinNames) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -733,21 +780,23 @@ subroutine NWTC_Library_UnPackModVarType(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%Name); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Field); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Nodes); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Num); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Flags); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DerivOrder); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iLoc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iSol); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iLin); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iq); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%iUsr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%jUsr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%MeshID); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Solve); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iLoc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iGlu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iLB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iUB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%j); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%m); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Perturb); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackDatLoc(RF, OutData%DL) ! DL + call RegUnpack(RF, OutData%Name); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LinNames); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -764,8 +813,10 @@ subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, character(*), parameter :: RoutineName = 'NWTC_Library_CopyModVarsType' ErrStat = ErrID_None ErrMsg = '' - DstModVarsTypeData%ModNum = SrcModVarsTypeData%ModNum - DstModVarsTypeData%ModAbbr = SrcModVarsTypeData%ModAbbr + DstModVarsTypeData%Nx = SrcModVarsTypeData%Nx + DstModVarsTypeData%Nz = SrcModVarsTypeData%Nz + DstModVarsTypeData%Nu = SrcModVarsTypeData%Nu + DstModVarsTypeData%Ny = SrcModVarsTypeData%Ny if (allocated(SrcModVarsTypeData%x)) then LB(1:1) = lbound(SrcModVarsTypeData%x) UB(1:1) = ubound(SrcModVarsTypeData%x) @@ -782,6 +833,22 @@ subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, if (ErrStat >= AbortErrLev) return end do end if + if (allocated(SrcModVarsTypeData%z)) then + LB(1:1) = lbound(SrcModVarsTypeData%z) + UB(1:1) = ubound(SrcModVarsTypeData%z) + if (.not. allocated(DstModVarsTypeData%z)) then + allocate(DstModVarsTypeData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyModVarType(SrcModVarsTypeData%z(i1), DstModVarsTypeData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if if (allocated(SrcModVarsTypeData%u)) then LB(1:1) = lbound(SrcModVarsTypeData%u) UB(1:1) = ubound(SrcModVarsTypeData%u) @@ -814,9 +881,6 @@ subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, if (ErrStat >= AbortErrLev) return end do end if - DstModVarsTypeData%Nx = SrcModVarsTypeData%Nx - DstModVarsTypeData%Nu = SrcModVarsTypeData%Nu - DstModVarsTypeData%Ny = SrcModVarsTypeData%Ny end subroutine subroutine NWTC_Library_DestroyModVarsType(ModVarsTypeData, ErrStat, ErrMsg) @@ -839,6 +903,15 @@ subroutine NWTC_Library_DestroyModVarsType(ModVarsTypeData, ErrStat, ErrMsg) end do deallocate(ModVarsTypeData%x) end if + if (allocated(ModVarsTypeData%z)) then + LB(1:1) = lbound(ModVarsTypeData%z) + UB(1:1) = ubound(ModVarsTypeData%z) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyModVarType(ModVarsTypeData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModVarsTypeData%z) + end if if (allocated(ModVarsTypeData%u)) then LB(1:1) = lbound(ModVarsTypeData%u) UB(1:1) = ubound(ModVarsTypeData%u) @@ -866,8 +939,10 @@ subroutine NWTC_Library_PackModVarsType(RF, Indata) integer(B4Ki) :: i1 integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%ModNum) - call RegPack(RF, InData%ModAbbr) + call RegPack(RF, InData%Nx) + call RegPack(RF, InData%Nz) + call RegPack(RF, InData%Nu) + call RegPack(RF, InData%Ny) call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) @@ -877,6 +952,15 @@ subroutine NWTC_Library_PackModVarsType(RF, Indata) call NWTC_Library_PackModVarType(RF, InData%x(i1)) end do end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call NWTC_Library_PackModVarType(RF, InData%z(i1)) + end do + end if call RegPack(RF, allocated(InData%u)) if (allocated(InData%u)) then call RegPackBounds(RF, 1, lbound(InData%u), ubound(InData%u)) @@ -895,9 +979,6 @@ subroutine NWTC_Library_PackModVarsType(RF, Indata) call NWTC_Library_PackModVarType(RF, InData%y(i1)) end do end if - call RegPack(RF, InData%Nx) - call RegPack(RF, InData%Nu) - call RegPack(RF, InData%Ny) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -910,8 +991,10 @@ subroutine NWTC_Library_UnPackModVarsType(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%ModNum); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ModAbbr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ny); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%x)) deallocate(OutData%x) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -925,6 +1008,19 @@ subroutine NWTC_Library_UnPackModVarsType(RF, OutData) call NWTC_Library_UnpackModVarType(RF, OutData%x(i1)) ! x end do end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackModVarType(RF, OutData%z(i1)) ! z + end do + end if if (allocated(OutData%u)) deallocate(OutData%u) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -951,287 +1047,540 @@ subroutine NWTC_Library_UnPackModVarsType(RF, OutData) call NWTC_Library_UnpackModVarType(RF, OutData%y(i1)) ! y end do end if +end subroutine + +subroutine NWTC_Library_CopyModJacType(SrcModJacTypeData, DstModJacTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModJacType), intent(in) :: SrcModJacTypeData + type(ModJacType), intent(inout) :: DstModJacTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyModJacType' + ErrStat = ErrID_None + ErrMsg = '' + DstModJacTypeData%Nx = SrcModJacTypeData%Nx + DstModJacTypeData%Nz = SrcModJacTypeData%Nz + DstModJacTypeData%Nu = SrcModJacTypeData%Nu + DstModJacTypeData%Ny = SrcModJacTypeData%Ny + if (allocated(SrcModJacTypeData%x)) then + LB(1:1) = lbound(SrcModJacTypeData%x) + UB(1:1) = ubound(SrcModJacTypeData%x) + if (.not. allocated(DstModJacTypeData%x)) then + allocate(DstModJacTypeData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%x = SrcModJacTypeData%x + end if + if (allocated(SrcModJacTypeData%z)) then + LB(1:1) = lbound(SrcModJacTypeData%z) + UB(1:1) = ubound(SrcModJacTypeData%z) + if (.not. allocated(DstModJacTypeData%z)) then + allocate(DstModJacTypeData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%z = SrcModJacTypeData%z + end if + if (allocated(SrcModJacTypeData%u)) then + LB(1:1) = lbound(SrcModJacTypeData%u) + UB(1:1) = ubound(SrcModJacTypeData%u) + if (.not. allocated(DstModJacTypeData%u)) then + allocate(DstModJacTypeData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%u = SrcModJacTypeData%u + end if + if (allocated(SrcModJacTypeData%y)) then + LB(1:1) = lbound(SrcModJacTypeData%y) + UB(1:1) = ubound(SrcModJacTypeData%y) + if (.not. allocated(DstModJacTypeData%y)) then + allocate(DstModJacTypeData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%y = SrcModJacTypeData%y + end if + if (allocated(SrcModJacTypeData%x_perturb)) then + LB(1:1) = lbound(SrcModJacTypeData%x_perturb) + UB(1:1) = ubound(SrcModJacTypeData%x_perturb) + if (.not. allocated(DstModJacTypeData%x_perturb)) then + allocate(DstModJacTypeData%x_perturb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%x_perturb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%x_perturb = SrcModJacTypeData%x_perturb + end if + if (allocated(SrcModJacTypeData%z_perturb)) then + LB(1:1) = lbound(SrcModJacTypeData%z_perturb) + UB(1:1) = ubound(SrcModJacTypeData%z_perturb) + if (.not. allocated(DstModJacTypeData%z_perturb)) then + allocate(DstModJacTypeData%z_perturb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%z_perturb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%z_perturb = SrcModJacTypeData%z_perturb + end if + if (allocated(SrcModJacTypeData%u_perturb)) then + LB(1:1) = lbound(SrcModJacTypeData%u_perturb) + UB(1:1) = ubound(SrcModJacTypeData%u_perturb) + if (.not. allocated(DstModJacTypeData%u_perturb)) then + allocate(DstModJacTypeData%u_perturb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%u_perturb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%u_perturb = SrcModJacTypeData%u_perturb + end if + if (allocated(SrcModJacTypeData%x_pos)) then + LB(1:1) = lbound(SrcModJacTypeData%x_pos) + UB(1:1) = ubound(SrcModJacTypeData%x_pos) + if (.not. allocated(DstModJacTypeData%x_pos)) then + allocate(DstModJacTypeData%x_pos(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%x_pos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%x_pos = SrcModJacTypeData%x_pos + end if + if (allocated(SrcModJacTypeData%x_neg)) then + LB(1:1) = lbound(SrcModJacTypeData%x_neg) + UB(1:1) = ubound(SrcModJacTypeData%x_neg) + if (.not. allocated(DstModJacTypeData%x_neg)) then + allocate(DstModJacTypeData%x_neg(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%x_neg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%x_neg = SrcModJacTypeData%x_neg + end if + if (allocated(SrcModJacTypeData%y_pos)) then + LB(1:1) = lbound(SrcModJacTypeData%y_pos) + UB(1:1) = ubound(SrcModJacTypeData%y_pos) + if (.not. allocated(DstModJacTypeData%y_pos)) then + allocate(DstModJacTypeData%y_pos(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%y_pos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%y_pos = SrcModJacTypeData%y_pos + end if + if (allocated(SrcModJacTypeData%y_neg)) then + LB(1:1) = lbound(SrcModJacTypeData%y_neg) + UB(1:1) = ubound(SrcModJacTypeData%y_neg) + if (.not. allocated(DstModJacTypeData%y_neg)) then + allocate(DstModJacTypeData%y_neg(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%y_neg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%y_neg = SrcModJacTypeData%y_neg + end if + if (allocated(SrcModJacTypeData%StateRotation)) then + LB(1:2) = lbound(SrcModJacTypeData%StateRotation) + UB(1:2) = ubound(SrcModJacTypeData%StateRotation) + if (.not. allocated(DstModJacTypeData%StateRotation)) then + allocate(DstModJacTypeData%StateRotation(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModJacTypeData%StateRotation.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModJacTypeData%StateRotation = SrcModJacTypeData%StateRotation + end if +end subroutine + +subroutine NWTC_Library_DestroyModJacType(ModJacTypeData, ErrStat, ErrMsg) + type(ModJacType), intent(inout) :: ModJacTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModJacType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModJacTypeData%x)) then + deallocate(ModJacTypeData%x) + end if + if (allocated(ModJacTypeData%z)) then + deallocate(ModJacTypeData%z) + end if + if (allocated(ModJacTypeData%u)) then + deallocate(ModJacTypeData%u) + end if + if (allocated(ModJacTypeData%y)) then + deallocate(ModJacTypeData%y) + end if + if (allocated(ModJacTypeData%x_perturb)) then + deallocate(ModJacTypeData%x_perturb) + end if + if (allocated(ModJacTypeData%z_perturb)) then + deallocate(ModJacTypeData%z_perturb) + end if + if (allocated(ModJacTypeData%u_perturb)) then + deallocate(ModJacTypeData%u_perturb) + end if + if (allocated(ModJacTypeData%x_pos)) then + deallocate(ModJacTypeData%x_pos) + end if + if (allocated(ModJacTypeData%x_neg)) then + deallocate(ModJacTypeData%x_neg) + end if + if (allocated(ModJacTypeData%y_pos)) then + deallocate(ModJacTypeData%y_pos) + end if + if (allocated(ModJacTypeData%y_neg)) then + deallocate(ModJacTypeData%y_neg) + end if + if (allocated(ModJacTypeData%StateRotation)) then + deallocate(ModJacTypeData%StateRotation) + end if +end subroutine + +subroutine NWTC_Library_PackModJacType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ModJacType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackModJacType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Nx) + call RegPack(RF, InData%Nz) + call RegPack(RF, InData%Nu) + call RegPack(RF, InData%Ny) + call RegPackAlloc(RF, InData%x) + call RegPackAlloc(RF, InData%z) + call RegPackAlloc(RF, InData%u) + call RegPackAlloc(RF, InData%y) + call RegPackAlloc(RF, InData%x_perturb) + call RegPackAlloc(RF, InData%z_perturb) + call RegPackAlloc(RF, InData%u_perturb) + call RegPackAlloc(RF, InData%x_pos) + call RegPackAlloc(RF, InData%x_neg) + call RegPackAlloc(RF, InData%y_pos) + call RegPackAlloc(RF, InData%y_neg) + call RegPackAlloc(RF, InData%StateRotation) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackModJacType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ModJacType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModJacType' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nz); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Nu); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_perturb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%z_perturb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u_perturb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_pos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_neg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_pos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_neg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StateRotation); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine NWTC_Library_CopyModValsType(SrcModValsTypeData, DstModValsTypeData, CtrlCode, ErrStat, ErrMsg) - type(ModValsType), intent(in) :: SrcModValsTypeData - type(ModValsType), intent(inout) :: DstModValsTypeData +subroutine NWTC_Library_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModLinType), intent(in) :: SrcModLinTypeData + type(ModLinType), intent(inout) :: DstModLinTypeData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'NWTC_Library_CopyModValsType' + character(*), parameter :: RoutineName = 'NWTC_Library_CopyModLinType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcModValsTypeData%x)) then - LB(1:1) = lbound(SrcModValsTypeData%x) - UB(1:1) = ubound(SrcModValsTypeData%x) - if (.not. allocated(DstModValsTypeData%x)) then - allocate(DstModValsTypeData%x(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%x)) then + LB(1:1) = lbound(SrcModLinTypeData%x) + UB(1:1) = ubound(SrcModLinTypeData%x) + if (.not. allocated(DstModLinTypeData%x)) then + allocate(DstModLinTypeData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%x.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%x.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%x = SrcModValsTypeData%x + DstModLinTypeData%x = SrcModLinTypeData%x end if - if (allocated(SrcModValsTypeData%dxdt)) then - LB(1:1) = lbound(SrcModValsTypeData%dxdt) - UB(1:1) = ubound(SrcModValsTypeData%dxdt) - if (.not. allocated(DstModValsTypeData%dxdt)) then - allocate(DstModValsTypeData%dxdt(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%dx)) then + LB(1:1) = lbound(SrcModLinTypeData%dx) + UB(1:1) = ubound(SrcModLinTypeData%dx) + if (.not. allocated(DstModLinTypeData%dx)) then + allocate(DstModLinTypeData%dx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dxdt.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dx.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%dxdt = SrcModValsTypeData%dxdt + DstModLinTypeData%dx = SrcModLinTypeData%dx end if - if (allocated(SrcModValsTypeData%u)) then - LB(1:1) = lbound(SrcModValsTypeData%u) - UB(1:1) = ubound(SrcModValsTypeData%u) - if (.not. allocated(DstModValsTypeData%u)) then - allocate(DstModValsTypeData%u(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%z)) then + LB(1:1) = lbound(SrcModLinTypeData%z) + UB(1:1) = ubound(SrcModLinTypeData%z) + if (.not. allocated(DstModLinTypeData%z)) then + allocate(DstModLinTypeData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%u.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%z.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%u = SrcModValsTypeData%u + DstModLinTypeData%z = SrcModLinTypeData%z end if - if (allocated(SrcModValsTypeData%y)) then - LB(1:1) = lbound(SrcModValsTypeData%y) - UB(1:1) = ubound(SrcModValsTypeData%y) - if (.not. allocated(DstModValsTypeData%y)) then - allocate(DstModValsTypeData%y(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%u)) then + LB(1:1) = lbound(SrcModLinTypeData%u) + UB(1:1) = ubound(SrcModLinTypeData%u) + if (.not. allocated(DstModLinTypeData%u)) then + allocate(DstModLinTypeData%u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%y.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%u.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%y = SrcModValsTypeData%y + DstModLinTypeData%u = SrcModLinTypeData%u end if - if (allocated(SrcModValsTypeData%u_perturb)) then - LB(1:1) = lbound(SrcModValsTypeData%u_perturb) - UB(1:1) = ubound(SrcModValsTypeData%u_perturb) - if (.not. allocated(DstModValsTypeData%u_perturb)) then - allocate(DstModValsTypeData%u_perturb(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%y)) then + LB(1:1) = lbound(SrcModLinTypeData%y) + UB(1:1) = ubound(SrcModLinTypeData%y) + if (.not. allocated(DstModLinTypeData%y)) then + allocate(DstModLinTypeData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%u_perturb.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%y.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%u_perturb = SrcModValsTypeData%u_perturb + DstModLinTypeData%y = SrcModLinTypeData%y end if - if (allocated(SrcModValsTypeData%x_perturb)) then - LB(1:1) = lbound(SrcModValsTypeData%x_perturb) - UB(1:1) = ubound(SrcModValsTypeData%x_perturb) - if (.not. allocated(DstModValsTypeData%x_perturb)) then - allocate(DstModValsTypeData%x_perturb(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%J)) then + LB(1:2) = lbound(SrcModLinTypeData%J) + UB(1:2) = ubound(SrcModLinTypeData%J) + if (.not. allocated(DstModLinTypeData%J)) then + allocate(DstModLinTypeData%J(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%x_perturb.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%J.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%x_perturb = SrcModValsTypeData%x_perturb + DstModLinTypeData%J = SrcModLinTypeData%J end if - if (allocated(SrcModValsTypeData%xp)) then - LB(1:1) = lbound(SrcModValsTypeData%xp) - UB(1:1) = ubound(SrcModValsTypeData%xp) - if (.not. allocated(DstModValsTypeData%xp)) then - allocate(DstModValsTypeData%xp(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%dYdx)) then + LB(1:2) = lbound(SrcModLinTypeData%dYdx) + UB(1:2) = ubound(SrcModLinTypeData%dYdx) + if (.not. allocated(DstModLinTypeData%dYdx)) then + allocate(DstModLinTypeData%dYdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%xp.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dYdx.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%xp = SrcModValsTypeData%xp + DstModLinTypeData%dYdx = SrcModLinTypeData%dYdx end if - if (allocated(SrcModValsTypeData%xn)) then - LB(1:1) = lbound(SrcModValsTypeData%xn) - UB(1:1) = ubound(SrcModValsTypeData%xn) - if (.not. allocated(DstModValsTypeData%xn)) then - allocate(DstModValsTypeData%xn(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%dXdx)) then + LB(1:2) = lbound(SrcModLinTypeData%dXdx) + UB(1:2) = ubound(SrcModLinTypeData%dXdx) + if (.not. allocated(DstModLinTypeData%dXdx)) then + allocate(DstModLinTypeData%dXdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%xn.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dXdx.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%xn = SrcModValsTypeData%xn + DstModLinTypeData%dXdx = SrcModLinTypeData%dXdx end if - if (allocated(SrcModValsTypeData%yp)) then - LB(1:1) = lbound(SrcModValsTypeData%yp) - UB(1:1) = ubound(SrcModValsTypeData%yp) - if (.not. allocated(DstModValsTypeData%yp)) then - allocate(DstModValsTypeData%yp(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%dYdu)) then + LB(1:2) = lbound(SrcModLinTypeData%dYdu) + UB(1:2) = ubound(SrcModLinTypeData%dYdu) + if (.not. allocated(DstModLinTypeData%dYdu)) then + allocate(DstModLinTypeData%dYdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%yp.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dYdu.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%yp = SrcModValsTypeData%yp + DstModLinTypeData%dYdu = SrcModLinTypeData%dYdu end if - if (allocated(SrcModValsTypeData%yn)) then - LB(1:1) = lbound(SrcModValsTypeData%yn) - UB(1:1) = ubound(SrcModValsTypeData%yn) - if (.not. allocated(DstModValsTypeData%yn)) then - allocate(DstModValsTypeData%yn(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%dXdu)) then + LB(1:2) = lbound(SrcModLinTypeData%dXdu) + UB(1:2) = ubound(SrcModLinTypeData%dXdu) + if (.not. allocated(DstModLinTypeData%dXdu)) then + allocate(DstModLinTypeData%dXdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%yn.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dXdu.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%yn = SrcModValsTypeData%yn + DstModLinTypeData%dXdu = SrcModLinTypeData%dXdu end if - if (allocated(SrcModValsTypeData%dYdx)) then - LB(1:2) = lbound(SrcModValsTypeData%dYdx) - UB(1:2) = ubound(SrcModValsTypeData%dYdx) - if (.not. allocated(DstModValsTypeData%dYdx)) then - allocate(DstModValsTypeData%dYdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%dXdy)) then + LB(1:2) = lbound(SrcModLinTypeData%dXdy) + UB(1:2) = ubound(SrcModLinTypeData%dXdy) + if (.not. allocated(DstModLinTypeData%dXdy)) then + allocate(DstModLinTypeData%dXdy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dYdx.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dXdy.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%dYdx = SrcModValsTypeData%dYdx + DstModLinTypeData%dXdy = SrcModLinTypeData%dXdy end if - if (allocated(SrcModValsTypeData%dXdx)) then - LB(1:2) = lbound(SrcModValsTypeData%dXdx) - UB(1:2) = ubound(SrcModValsTypeData%dXdx) - if (.not. allocated(DstModValsTypeData%dXdx)) then - allocate(DstModValsTypeData%dXdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%dUdu)) then + LB(1:2) = lbound(SrcModLinTypeData%dUdu) + UB(1:2) = ubound(SrcModLinTypeData%dUdu) + if (.not. allocated(DstModLinTypeData%dUdu)) then + allocate(DstModLinTypeData%dUdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dXdx.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dUdu.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%dXdx = SrcModValsTypeData%dXdx + DstModLinTypeData%dUdu = SrcModLinTypeData%dUdu end if - if (allocated(SrcModValsTypeData%dYdu)) then - LB(1:2) = lbound(SrcModValsTypeData%dYdu) - UB(1:2) = ubound(SrcModValsTypeData%dYdu) - if (.not. allocated(DstModValsTypeData%dYdu)) then - allocate(DstModValsTypeData%dYdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%dUdy)) then + LB(1:2) = lbound(SrcModLinTypeData%dUdy) + UB(1:2) = ubound(SrcModLinTypeData%dUdy) + if (.not. allocated(DstModLinTypeData%dUdy)) then + allocate(DstModLinTypeData%dUdy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dYdu.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%dUdy.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%dYdu = SrcModValsTypeData%dYdu + DstModLinTypeData%dUdy = SrcModLinTypeData%dUdy end if - if (allocated(SrcModValsTypeData%dXdu)) then - LB(1:2) = lbound(SrcModValsTypeData%dXdu) - UB(1:2) = ubound(SrcModValsTypeData%dXdu) - if (.not. allocated(DstModValsTypeData%dXdu)) then - allocate(DstModValsTypeData%dXdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcModLinTypeData%StateRotation)) then + LB(1:2) = lbound(SrcModLinTypeData%StateRotation) + UB(1:2) = ubound(SrcModLinTypeData%StateRotation) + if (.not. allocated(DstModLinTypeData%StateRotation)) then + allocate(DstModLinTypeData%StateRotation(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dXdu.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%StateRotation.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModValsTypeData%dXdu = SrcModValsTypeData%dXdu + DstModLinTypeData%StateRotation = SrcModLinTypeData%StateRotation end if end subroutine -subroutine NWTC_Library_DestroyModValsType(ModValsTypeData, ErrStat, ErrMsg) - type(ModValsType), intent(inout) :: ModValsTypeData +subroutine NWTC_Library_DestroyModLinType(ModLinTypeData, ErrStat, ErrMsg) + type(ModLinType), intent(inout) :: ModLinTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModValsType' + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModLinType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(ModValsTypeData%x)) then - deallocate(ModValsTypeData%x) + if (allocated(ModLinTypeData%x)) then + deallocate(ModLinTypeData%x) end if - if (allocated(ModValsTypeData%dxdt)) then - deallocate(ModValsTypeData%dxdt) + if (allocated(ModLinTypeData%dx)) then + deallocate(ModLinTypeData%dx) end if - if (allocated(ModValsTypeData%u)) then - deallocate(ModValsTypeData%u) + if (allocated(ModLinTypeData%z)) then + deallocate(ModLinTypeData%z) end if - if (allocated(ModValsTypeData%y)) then - deallocate(ModValsTypeData%y) + if (allocated(ModLinTypeData%u)) then + deallocate(ModLinTypeData%u) end if - if (allocated(ModValsTypeData%u_perturb)) then - deallocate(ModValsTypeData%u_perturb) + if (allocated(ModLinTypeData%y)) then + deallocate(ModLinTypeData%y) end if - if (allocated(ModValsTypeData%x_perturb)) then - deallocate(ModValsTypeData%x_perturb) + if (allocated(ModLinTypeData%J)) then + deallocate(ModLinTypeData%J) end if - if (allocated(ModValsTypeData%xp)) then - deallocate(ModValsTypeData%xp) + if (allocated(ModLinTypeData%dYdx)) then + deallocate(ModLinTypeData%dYdx) end if - if (allocated(ModValsTypeData%xn)) then - deallocate(ModValsTypeData%xn) + if (allocated(ModLinTypeData%dXdx)) then + deallocate(ModLinTypeData%dXdx) end if - if (allocated(ModValsTypeData%yp)) then - deallocate(ModValsTypeData%yp) + if (allocated(ModLinTypeData%dYdu)) then + deallocate(ModLinTypeData%dYdu) end if - if (allocated(ModValsTypeData%yn)) then - deallocate(ModValsTypeData%yn) + if (allocated(ModLinTypeData%dXdu)) then + deallocate(ModLinTypeData%dXdu) end if - if (allocated(ModValsTypeData%dYdx)) then - deallocate(ModValsTypeData%dYdx) + if (allocated(ModLinTypeData%dXdy)) then + deallocate(ModLinTypeData%dXdy) end if - if (allocated(ModValsTypeData%dXdx)) then - deallocate(ModValsTypeData%dXdx) + if (allocated(ModLinTypeData%dUdu)) then + deallocate(ModLinTypeData%dUdu) end if - if (allocated(ModValsTypeData%dYdu)) then - deallocate(ModValsTypeData%dYdu) + if (allocated(ModLinTypeData%dUdy)) then + deallocate(ModLinTypeData%dUdy) end if - if (allocated(ModValsTypeData%dXdu)) then - deallocate(ModValsTypeData%dXdu) + if (allocated(ModLinTypeData%StateRotation)) then + deallocate(ModLinTypeData%StateRotation) end if end subroutine -subroutine NWTC_Library_PackModValsType(RF, Indata) +subroutine NWTC_Library_PackModLinType(RF, Indata) type(RegFile), intent(inout) :: RF - type(ModValsType), intent(in) :: InData - character(*), parameter :: RoutineName = 'NWTC_Library_PackModValsType' + type(ModLinType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackModLinType' if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%x) - call RegPackAlloc(RF, InData%dxdt) + call RegPackAlloc(RF, InData%dx) + call RegPackAlloc(RF, InData%z) call RegPackAlloc(RF, InData%u) call RegPackAlloc(RF, InData%y) - call RegPackAlloc(RF, InData%u_perturb) - call RegPackAlloc(RF, InData%x_perturb) - call RegPackAlloc(RF, InData%xp) - call RegPackAlloc(RF, InData%xn) - call RegPackAlloc(RF, InData%yp) - call RegPackAlloc(RF, InData%yn) + call RegPackAlloc(RF, InData%J) call RegPackAlloc(RF, InData%dYdx) call RegPackAlloc(RF, InData%dXdx) call RegPackAlloc(RF, InData%dYdu) call RegPackAlloc(RF, InData%dXdu) + call RegPackAlloc(RF, InData%dXdy) + call RegPackAlloc(RF, InData%dUdu) + call RegPackAlloc(RF, InData%dUdy) + call RegPackAlloc(RF, InData%StateRotation) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine NWTC_Library_UnPackModValsType(RF, OutData) +subroutine NWTC_Library_UnPackModLinType(RF, OutData) type(RegFile), intent(inout) :: RF - type(ModValsType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModValsType' + type(ModLinType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModLinType' integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dxdt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%z); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%u_perturb); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%x_perturb); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%xp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%xn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%yp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%yn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%J); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%dYdx); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%dXdx); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%dYdu); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%dXdu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dXdy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dUdu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dUdy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StateRotation); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine NWTC_Library_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, CtrlCode, ErrStat, ErrMsg) @@ -1240,80 +1589,23 @@ subroutine NWTC_Library_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyModDataType' ErrStat = ErrID_None ErrMsg = '' - DstModDataTypeData%Idx = SrcModDataTypeData%Idx - DstModDataTypeData%ID = SrcModDataTypeData%ID DstModDataTypeData%Abbr = SrcModDataTypeData%Abbr + DstModDataTypeData%iMod = SrcModDataTypeData%iMod + DstModDataTypeData%ID = SrcModDataTypeData%ID DstModDataTypeData%Ins = SrcModDataTypeData%Ins - DstModDataTypeData%IsTC = SrcModDataTypeData%IsTC - DstModDataTypeData%DT = SrcModDataTypeData%DT DstModDataTypeData%SubSteps = SrcModDataTypeData%SubSteps - if (allocated(SrcModDataTypeData%ixs)) then - LB(1:2) = lbound(SrcModDataTypeData%ixs) - UB(1:2) = ubound(SrcModDataTypeData%ixs) - if (.not. allocated(DstModDataTypeData%ixs)) then - allocate(DstModDataTypeData%ixs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%ixs.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModDataTypeData%ixs = SrcModDataTypeData%ixs - end if - if (allocated(SrcModDataTypeData%ius)) then - LB(1:2) = lbound(SrcModDataTypeData%ius) - UB(1:2) = ubound(SrcModDataTypeData%ius) - if (.not. allocated(DstModDataTypeData%ius)) then - allocate(DstModDataTypeData%ius(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%ius.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModDataTypeData%ius = SrcModDataTypeData%ius - end if - if (allocated(SrcModDataTypeData%iys)) then - LB(1:2) = lbound(SrcModDataTypeData%iys) - UB(1:2) = ubound(SrcModDataTypeData%iys) - if (.not. allocated(DstModDataTypeData%iys)) then - allocate(DstModDataTypeData%iys(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%iys.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModDataTypeData%iys = SrcModDataTypeData%iys - end if - DstModDataTypeData%Vars => SrcModDataTypeData%Vars - if (allocated(SrcModDataTypeData%SrcMaps)) then - LB(1:1) = lbound(SrcModDataTypeData%SrcMaps) - UB(1:1) = ubound(SrcModDataTypeData%SrcMaps) - if (.not. allocated(DstModDataTypeData%SrcMaps)) then - allocate(DstModDataTypeData%SrcMaps(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%SrcMaps.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModDataTypeData%SrcMaps = SrcModDataTypeData%SrcMaps - end if - if (allocated(SrcModDataTypeData%DstMaps)) then - LB(1:1) = lbound(SrcModDataTypeData%DstMaps) - UB(1:1) = ubound(SrcModDataTypeData%DstMaps) - if (.not. allocated(DstModDataTypeData%DstMaps)) then - allocate(DstModDataTypeData%DstMaps(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%DstMaps.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModDataTypeData%DstMaps = SrcModDataTypeData%DstMaps - end if + DstModDataTypeData%DT = SrcModDataTypeData%DT + call NWTC_Library_CopyModVarsType(SrcModDataTypeData%Vars, DstModDataTypeData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyModLinType(SrcModDataTypeData%Lin, DstModDataTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine NWTC_Library_DestroyModDataType(ModDataTypeData, ErrStat, ErrMsg) @@ -1325,49 +1617,25 @@ subroutine NWTC_Library_DestroyModDataType(ModDataTypeData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModDataType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(ModDataTypeData%ixs)) then - deallocate(ModDataTypeData%ixs) - end if - if (allocated(ModDataTypeData%ius)) then - deallocate(ModDataTypeData%ius) - end if - if (allocated(ModDataTypeData%iys)) then - deallocate(ModDataTypeData%iys) - end if - nullify(ModDataTypeData%Vars) - if (allocated(ModDataTypeData%SrcMaps)) then - deallocate(ModDataTypeData%SrcMaps) - end if - if (allocated(ModDataTypeData%DstMaps)) then - deallocate(ModDataTypeData%DstMaps) - end if + call NWTC_Library_DestroyModVarsType(ModDataTypeData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModLinType(ModDataTypeData%Lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine NWTC_Library_PackModDataType(RF, Indata) type(RegFile), intent(inout) :: RF type(ModDataType), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackModDataType' - logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%Idx) - call RegPack(RF, InData%ID) call RegPack(RF, InData%Abbr) + call RegPack(RF, InData%iMod) + call RegPack(RF, InData%ID) call RegPack(RF, InData%Ins) - call RegPack(RF, InData%IsTC) - call RegPack(RF, InData%DT) call RegPack(RF, InData%SubSteps) - call RegPackAlloc(RF, InData%ixs) - call RegPackAlloc(RF, InData%ius) - call RegPackAlloc(RF, InData%iys) - call RegPack(RF, associated(InData%Vars)) - if (associated(InData%Vars)) then - call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) - if (.not. PtrInIndex) then - call NWTC_Library_PackModVarsType(RF, InData%Vars) - end if - end if - call RegPackAlloc(RF, InData%SrcMaps) - call RegPackAlloc(RF, InData%DstMaps) + call RegPack(RF, InData%DT) + call NWTC_Library_PackModVarsType(RF, InData%Vars) + call NWTC_Library_PackModLinType(RF, InData%Lin) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1375,42 +1643,17 @@ subroutine NWTC_Library_UnPackModDataType(RF, OutData) type(RegFile), intent(inout) :: RF type(ModDataType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModDataType' - integer(B4Ki) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc - integer(B8Ki) :: PtrIdx - type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%Idx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ID); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Abbr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ID); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Ins); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%IsTC); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SubSteps); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ixs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ius); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%iys); if (RegCheckErr(RF, RoutineName)) return - if (associated(OutData%Vars)) deallocate(OutData%Vars) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Vars) - else - allocate(OutData%Vars,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - RF%Pointers(PtrIdx) = c_loc(OutData%Vars) - call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars - end if - else - OutData%Vars => null() - end if - call RegUnpackAlloc(RF, OutData%SrcMaps); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%DstMaps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + call NWTC_Library_UnpackModLinType(RF, OutData%Lin) ! Lin end subroutine + END MODULE NWTC_Library_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/NWTC_Num.f90 b/modules/nwtc-library/src/NWTC_Num.f90 index 4316131007..e4a74c31d1 100644 --- a/modules/nwtc-library/src/NWTC_Num.f90 +++ b/modules/nwtc-library/src/NWTC_Num.f90 @@ -1632,7 +1632,7 @@ END SUBROUTINE DCM_SetLogMapForInterpR !! !! Note that the numbers are added together in this routine, so overflow can result if comparing two "huge" numbers. \n !! Use EqualRealNos (nwtc_num::equalrealnos) instead of directly calling a specific routine in the generic interface. - FUNCTION EqualRealNos4 ( ReNum1, ReNum2 ) + PURE FUNCTION EqualRealNos4 ( ReNum1, ReNum2 ) ! passed variables @@ -1666,7 +1666,7 @@ FUNCTION EqualRealNos4 ( ReNum1, ReNum2 ) END FUNCTION EqualRealNos4 !======================================================================= !> \copydoc nwtc_num::equalrealnos4 - FUNCTION EqualRealNos8 ( ReNum1, ReNum2 ) + PURE FUNCTION EqualRealNos8 ( ReNum1, ReNum2 ) ! passed variables diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index a4cd50c404..78921cf0c8 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -45,83 +45,114 @@ typedef ^ ^ CHARACTER(6) RNG_type param ^ - IntKi VarNameLen - 64 - "" - -param ^ - IntKi VF_Force - 1 - "" - -param ^ - IntKi VF_Moment - 2 - "" - -param ^ - IntKi VF_Orientation - 3 - "" - -param ^ - IntKi VF_TransDisp - 4 - "" - -param ^ - IntKi VF_AngularDisp - 5 - "" - -param ^ - IntKi VF_TransVel - 6 - "" - -param ^ - IntKi VF_AngularVel - 7 - "" - -param ^ - IntKi VF_TransAcc - 8 - "" - -param ^ - IntKi VF_AngularAcc - 9 - "" - -param ^ - IntKi VF_Scalar - 10 - "" - - -param ^ - IntKi VF_None - 0 - "Variable with no flags" - -param ^ - IntKi VF_Mesh - 1 - "Variable contained in mesh" - -param ^ - IntKi VF_Line - 2 - "Variable is for a line mesh" - -param ^ - IntKi VF_RotFrame - 4 - "Variable in rotating frame" - -param ^ - IntKi VF_Ext - 8 - "Variable for extended linearization" - -param ^ - IntKi VF_Any - 4095 - "Enable all flags (used for filtering)" - +param ^ - IntKi FieldForce - 1 - "" - +param ^ - IntKi FieldMoment - 2 - "" - +param ^ - IntKi FieldOrientation - 3 - "" - +param ^ - IntKi FieldTransDisp - 4 - "" - +param ^ - IntKi FieldTransVel - 5 - "" - +param ^ - IntKi FieldAngularVel - 6 - "" - +param ^ - IntKi FieldTransAcc - 7 - "" - +param ^ - IntKi FieldAngularAcc - 8 - "" - +param ^ - IntKi FieldScalar - 9 - "" - +param ^ - IntKi FieldAngularDisp - 10 - "" - +param ^ - IntKi FieldCount - 10 - "" - + +param ^ - IntKi VF_None - 0 - "Variable with no flags" - +param ^ - IntKi VF_Mesh - 1 - "Variable contained in mesh" - +param ^ - IntKi VF_Line - 2 - "Variable is for a line mesh" - +param ^ - IntKi VF_RotFrame - 4 - "Variable in rotating frame" - +param ^ - IntKi VF_Linearize - 8 - "Variable for linearization" - +param ^ - IntKi VF_ExtLin - 16 - "Variable for extended linearization" - +param ^ - IntKi VF_SmallAngle - 32 - "Use small angles to calculate difference in linearization" - +param ^ - IntKi VF_2PI - 64 - "Variable is an angle with range [0,2pi]" - +param ^ - IntKi VF_WM_Rot - 128 - "Variable is a Wiener-Milenkovic rotation" - +param ^ - IntKi VF_WriteOut - 256 - "Variable for write output" - +param ^ - IntKi VF_Solve - 512 - "Variable for tight coupling solver" - +param ^ - IntKi VF_AeroMap - 1024 - "Variable for aeromap" - +param ^ - IntKi VF_DerivOrder1 - 2048 - "Variable is derivative order 1 in linearization file" - +param ^ - IntKi VF_DerivOrder2 - 4096 - "Variable is derivative order 2 in linearization file" - +param ^ - IntKi VF_Mapping - 8192 - "Variable is used in a module-to-module transfer mapping" - param ^ - IntKi VC_None - 0 - "" - param ^ - IntKi VC_Tight - 1 - "" - param ^ - IntKi VC_Option1 - 2 - "" - param ^ - IntKi VC_Option2 - 3 - "" - -typedef ^ ModVarType character(VarNameLen) Name - - - "" - -typedef ^ ^ IntKi Field - 0 - "" - +typedef ^ DatLoc IntKi Num - 0 - "Mesh number in module" +typedef ^ ^ IntKi i1 - 0 - "Index 1" +typedef ^ ^ IntKi i2 - 0 - "Index 2" +typedef ^ ^ IntKi i3 - 0 - "Index 3" +typedef ^ ^ IntKi i4 - 0 - "Index 4" +typedef ^ ^ IntKi i5 - 0 - "Index 5" + +typedef ^ ModVarType IntKi Field - 0 - "" - typedef ^ ^ IntKi Nodes - 1 - "" - typedef ^ ^ IntKi Num - 1 - "" - typedef ^ ^ IntKi Flags - 0 - "" - typedef ^ ^ IntKi DerivOrder - 0 - "" - -typedef ^ ^ IntKi iLoc : - - "indices in local arrays" - -typedef ^ ^ IntKi iSol : - - "indices in solver arrays" - -typedef ^ ^ IntKi iLin : - - "indices in linearization arrays" - -typedef ^ ^ IntKi iq : - - "row index in solver q matrix" - -typedef ^ ^ IntKi iUsr 2 - - "first user defined index for variable, can be used a lower/upper bounds" - -typedef ^ ^ IntKi jUsr - 0 - "second user defined index for variable" - -typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - -typedef ^ ^ logical Solve - F - "flag indicating that variable is used by solver" - -typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - +typedef ^ ^ IntKi iLoc 2 0 - "indices in module arrays" - +typedef ^ ^ IntKi iGlu 2 0 - "indices in module arrays" - +typedef ^ ^ IntKi iq 2 0 - "solver state row indices" - +typedef ^ ^ IntKi iLB - 0 - "first user defined index lower bound for variable" - +typedef ^ ^ IntKi iUB - 0 - "first user defined index upper bound for variable" - +typedef ^ ^ IntKi j - 0 - "second user defined index for variable" - +typedef ^ ^ IntKi k - 0 - "third user defined index for variable" - +typedef ^ ^ IntKi m - 0 - "fourth user defined index for variable" - +typedef ^ ^ IntKi n - 0 - "fifth user defined index for variable" - +typedef ^ ^ R8Ki Perturb - 0 - "perturbation amount for linearization" - +typedef ^ ^ DatLoc DL - - - "data location" - +typedef ^ ^ character(VarNameLen) Name - - - "" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - -typedef ^ ModVarsType IntKi ModNum - 0 - "" - -typedef ^ ^ character(6) ModAbbr - - - "" - -typedef ^ ^ ModVarType x : - - "Module state variable array" - -typedef ^ ^ ModVarType u : - - "Module input variable array" - -typedef ^ ^ ModVarType y : - - "Module output variable array" - -typedef ^ ^ IntKi Nx - - - "" - -typedef ^ ^ IntKi Nu - - - "" - -typedef ^ ^ IntKi Ny - - - "" - - -typedef ^ ModValsType R8Ki x : - - "" - -typedef ^ ^ R8Ki dxdt : - - "" - +typedef ^ ModVarsType IntKi Nx - 0 - "Number of x values" +typedef ^ ^ IntKi Nz - 0 - "Number of z values" +typedef ^ ^ IntKi Nu - 0 - "Number of u values" +typedef ^ ^ IntKi Ny - 0 - "Number of y values" +typedef ^ ^ ModVarType x : - - "Module state variable array" +typedef ^ ^ ModVarType z : - - "Module state variable array" +typedef ^ ^ ModVarType u : - - "Module input variable array" +typedef ^ ^ ModVarType y : - - "Module output variable array" + +typedef ^ ModJacType IntKi Nx - 0 - "Number of x values" +typedef ^ ^ IntKi Nz - 0 - "Number of z values" +typedef ^ ^ IntKi Nu - 0 - "Number of u values" +typedef ^ ^ IntKi Ny - 0 - "Number of y values" +typedef ^ ^ R8Ki x : - - "" - +typedef ^ ^ R8Ki z : - - "" - typedef ^ ^ R8Ki u : - - "" - typedef ^ ^ R8Ki y : - - "" - -typedef ^ ^ R8Ki u_perturb : - - "input perturbation array" - typedef ^ ^ R8Ki x_perturb : - - "" - -typedef ^ ^ R8Ki xp : - - "" - -typedef ^ ^ R8Ki xn : - - "" - -typedef ^ ^ R8Ki yp : - - "" - -typedef ^ ^ R8Ki yn : - - "" - +typedef ^ ^ R8Ki z_perturb : - - "" - +typedef ^ ^ R8Ki u_perturb : - - "" - +typedef ^ ^ R8Ki x_pos : - - "" - +typedef ^ ^ R8Ki x_neg : - - "" - +typedef ^ ^ R8Ki y_pos : - - "" - +typedef ^ ^ R8Ki y_neg : - - "" - +typedef ^ ^ R8Ki StateRotation :: - - "" - + +typedef ^ ModLinType R8Ki x : - - "" - +typedef ^ ^ R8Ki dx : - - "" - +typedef ^ ^ R8Ki z : - - "" - +typedef ^ ^ R8Ki u : - - "" - +typedef ^ ^ R8Ki y : - - "" - +typedef ^ ^ R8Ki J :: - - "" - typedef ^ ^ R8Ki dYdx :: - - "" - typedef ^ ^ R8Ki dXdx :: - - "" - typedef ^ ^ R8Ki dYdu :: - - "" - typedef ^ ^ R8Ki dXdu :: - - "" - +typedef ^ ^ R8Ki dXdy :: - - "" - +typedef ^ ^ R8Ki dUdu :: - - "" - +typedef ^ ^ R8Ki dUdy :: - - "" - +typedef ^ ^ R8Ki StateRotation :: - - "" - -typedef ^ ModDataType IntKi Idx - 0 - "Module index in array of modules" - +typedef ^ ModDataType character(ChanLen) Abbr - - - "Module name abbreviation" - +typedef ^ ^ IntKi iMod - 0 - "Module index in array of modules" - typedef ^ ^ IntKi ID - 0 - "Module identification number" - -typedef ^ ^ character(ChanLen) Abbr - - - "Module name abbreviation" - typedef ^ ^ IntKi Ins - 0 - "Module instance number" - -typedef ^ ^ logical IsTC - F - "Flag indicating module is part of tight coupling" - -typedef ^ ^ R8Ki DT - 0 - "Module time step" - typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - -typedef ^ ^ IntKi ixs :: - - "index array mapping local x vector to global x vector" - -typedef ^ ^ IntKi ius :: - - "index array mapping local u vector to global u vector" - -typedef ^ ^ IntKi iys :: - - "index array mapping local y vector to global y vector" - -typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - -typedef ^ ^ IntKi SrcMaps : - - "Indices of mappings where module is the source" -typedef ^ ^ IntKi DstMaps : - - "Indices of mappings where module is the destination" +typedef ^ ^ R8Ki DT - 0 - "Module time step" - +typedef ^ ^ ModVarsType Vars - - - "Module variables type" - +typedef ^ ^ ModLinType Lin - - - "Module linearization arrays and matrices" # This file defines types that may be used from the NWTC_Library # include this into a component registry file if you wish to use these types @@ -162,4 +193,3 @@ typedef ^ ^ R8Ki LoadLn2_F 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_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt index b5f52bb478..381e2ffc6f 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -45,80 +45,111 @@ typedef ^ ^ CHARACTER(6) RNG_type param ^ - IntKi VarNameLen - 64 - "" - -param ^ - IntKi VF_Force - 1 - "" - -param ^ - IntKi VF_Moment - 2 - "" - -param ^ - IntKi VF_Orientation - 3 - "" - -param ^ - IntKi VF_TransDisp - 4 - "" - -param ^ - IntKi VF_AngularDisp - 5 - "" - -param ^ - IntKi VF_TransVel - 6 - "" - -param ^ - IntKi VF_AngularVel - 7 - "" - -param ^ - IntKi VF_TransAcc - 8 - "" - -param ^ - IntKi VF_AngularAcc - 9 - "" - -param ^ - IntKi VF_Scalar - 10 - "" - - -param ^ - IntKi VF_None - 0 - "Variable with no flags" - -param ^ - IntKi VF_Mesh - 1 - "Variable contained in mesh" - -param ^ - IntKi VF_Line - 2 - "Variable is for a line mesh" - -param ^ - IntKi VF_RotFrame - 4 - "Variable in rotating frame" - -param ^ - IntKi VF_Ext - 8 - "Variable for extended linearization" - -param ^ - IntKi VF_Any - 4095 - "Enable all flags (used for filtering)" - +param ^ - IntKi FieldForce - 1 - "" - +param ^ - IntKi FieldMoment - 2 - "" - +param ^ - IntKi FieldOrientation - 3 - "" - +param ^ - IntKi FieldTransDisp - 4 - "" - +param ^ - IntKi FieldTransVel - 5 - "" - +param ^ - IntKi FieldAngularVel - 6 - "" - +param ^ - IntKi FieldTransAcc - 7 - "" - +param ^ - IntKi FieldAngularAcc - 8 - "" - +param ^ - IntKi FieldScalar - 9 - "" - +param ^ - IntKi FieldAngularDisp - 10 - "" - +param ^ - IntKi FieldCount - 10 - "" - + +param ^ - IntKi VF_None - 0 - "Variable with no flags" - +param ^ - IntKi VF_Mesh - 1 - "Variable contained in mesh" - +param ^ - IntKi VF_Line - 2 - "Variable is for a line mesh" - +param ^ - IntKi VF_RotFrame - 4 - "Variable in rotating frame" - +param ^ - IntKi VF_Linearize - 8 - "Variable for linearization" - +param ^ - IntKi VF_ExtLin - 16 - "Variable for extended linearization" - +param ^ - IntKi VF_SmallAngle - 32 - "Use small angles to calculate difference in linearization" - +param ^ - IntKi VF_2PI - 64 - "Variable is an angle with range [0,2pi]" - +param ^ - IntKi VF_WM_Rot - 128 - "Variable is a Wiener-Milenkovic rotation" - +param ^ - IntKi VF_WriteOut - 256 - "Variable for write output" - +param ^ - IntKi VF_Solve - 512 - "Variable for tight coupling solver" - +param ^ - IntKi VF_AeroMap - 1024 - "Variable for aeromap" - +param ^ - IntKi VF_DerivOrder1 - 2048 - "Variable is derivative order 1 in linearization file" - +param ^ - IntKi VF_DerivOrder2 - 4096 - "Variable is derivative order 2 in linearization file" - +param ^ - IntKi VF_Mapping - 8192 - "Variable is used in a module-to-module transfer mapping" - param ^ - IntKi VC_None - 0 - "" - param ^ - IntKi VC_Tight - 1 - "" - param ^ - IntKi VC_Option1 - 2 - "" - param ^ - IntKi VC_Option2 - 3 - "" - -typedef ^ ModVarType character(VarNameLen) Name - - - "" - -typedef ^ ^ IntKi Field - 0 - "" - +typedef ^ DatLoc IntKi Num - 0 - "Mesh number in module" +typedef ^ ^ IntKi i1 - 0 - "Index 1" +typedef ^ ^ IntKi i2 - 0 - "Index 2" +typedef ^ ^ IntKi i3 - 0 - "Index 3" +typedef ^ ^ IntKi i4 - 0 - "Index 4" +typedef ^ ^ IntKi i5 - 0 - "Index 5" + +typedef ^ ModVarType IntKi Field - 0 - "" - typedef ^ ^ IntKi Nodes - 1 - "" - typedef ^ ^ IntKi Num - 1 - "" - typedef ^ ^ IntKi Flags - 0 - "" - typedef ^ ^ IntKi DerivOrder - 0 - "" - -typedef ^ ^ IntKi iLoc : - - "indices in local arrays" - -typedef ^ ^ IntKi iSol : - - "indices in solver arrays" - -typedef ^ ^ IntKi iLin : - - "indices in linearization arrays" - -typedef ^ ^ IntKi iq : - - "row index in solver q matrix" - -typedef ^ ^ IntKi iUsr 2 - - "first user defined index for variable, can be used a lower/upper bounds" - -typedef ^ ^ IntKi jUsr - 0 - "second user defined index for variable" - -typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - -typedef ^ ^ logical Solve - F - "flag indicating that variable is used by solver" - -typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - +typedef ^ ^ IntKi iLoc 2 0 - "indices in module arrays" - +typedef ^ ^ IntKi iGlu 2 0 - "indices in module arrays" - +typedef ^ ^ IntKi iq 2 0 - "solver state row indices" - +typedef ^ ^ IntKi iLB - 0 - "first user defined index lower bound for variable" - +typedef ^ ^ IntKi iUB - 0 - "first user defined index upper bound for variable" - +typedef ^ ^ IntKi j - 0 - "second user defined index for variable" - +typedef ^ ^ IntKi k - 0 - "third user defined index for variable" - +typedef ^ ^ IntKi m - 0 - "fourth user defined index for variable" - +typedef ^ ^ IntKi n - 0 - "fifth user defined index for variable" - +typedef ^ ^ R8Ki Perturb - 0 - "perturbation amount for linearization" - +typedef ^ ^ DatLoc DL - - - "data location" - +typedef ^ ^ character(VarNameLen) Name - - - "" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - -typedef ^ ModVarsType IntKi ModNum - 0 - "" - -typedef ^ ^ character(6) ModAbbr - - - "" - -typedef ^ ^ ModVarType x : - - "Module state variable array" - -typedef ^ ^ ModVarType u : - - "Module input variable array" - -typedef ^ ^ ModVarType y : - - "Module output variable array" - -typedef ^ ^ IntKi Nx - - - "" - -typedef ^ ^ IntKi Nu - - - "" - -typedef ^ ^ IntKi Ny - - - "" - - -typedef ^ ModValsType R8Ki x : - - "" - -typedef ^ ^ R8Ki dxdt : - - "" - +typedef ^ ModVarsType IntKi Nx - 0 - "Number of x values" +typedef ^ ^ IntKi Nz - 0 - "Number of z values" +typedef ^ ^ IntKi Nu - 0 - "Number of u values" +typedef ^ ^ IntKi Ny - 0 - "Number of y values" +typedef ^ ^ ModVarType x : - - "Module state variable array" +typedef ^ ^ ModVarType z : - - "Module state variable array" +typedef ^ ^ ModVarType u : - - "Module input variable array" +typedef ^ ^ ModVarType y : - - "Module output variable array" + +typedef ^ ModJacType IntKi Nx - 0 - "Number of x values" +typedef ^ ^ IntKi Nz - 0 - "Number of z values" +typedef ^ ^ IntKi Nu - 0 - "Number of u values" +typedef ^ ^ IntKi Ny - 0 - "Number of y values" +typedef ^ ^ R8Ki x : - - "" - +typedef ^ ^ R8Ki z : - - "" - typedef ^ ^ R8Ki u : - - "" - typedef ^ ^ R8Ki y : - - "" - -typedef ^ ^ R8Ki u_perturb : - - "input perturbation array" - typedef ^ ^ R8Ki x_perturb : - - "" - -typedef ^ ^ R8Ki xp : - - "" - -typedef ^ ^ R8Ki xn : - - "" - -typedef ^ ^ R8Ki yp : - - "" - -typedef ^ ^ R8Ki yn : - - "" - +typedef ^ ^ R8Ki z_perturb : - - "" - +typedef ^ ^ R8Ki u_perturb : - - "" - +typedef ^ ^ R8Ki x_pos : - - "" - +typedef ^ ^ R8Ki x_neg : - - "" - +typedef ^ ^ R8Ki y_pos : - - "" - +typedef ^ ^ R8Ki y_neg : - - "" - +typedef ^ ^ R8Ki StateRotation :: - - "" - + +typedef ^ ModLinType R8Ki x : - - "" - +typedef ^ ^ R8Ki dx : - - "" - +typedef ^ ^ R8Ki z : - - "" - +typedef ^ ^ R8Ki u : - - "" - +typedef ^ ^ R8Ki y : - - "" - +typedef ^ ^ R8Ki J :: - - "" - typedef ^ ^ R8Ki dYdx :: - - "" - typedef ^ ^ R8Ki dXdx :: - - "" - typedef ^ ^ R8Ki dYdu :: - - "" - typedef ^ ^ R8Ki dXdu :: - - "" - +typedef ^ ^ R8Ki dXdy :: - - "" - +typedef ^ ^ R8Ki dUdu :: - - "" - +typedef ^ ^ R8Ki dUdy :: - - "" - +typedef ^ ^ R8Ki StateRotation :: - - "" - -typedef ^ ModDataType IntKi Idx - 0 - "Module index in array of modules" - +typedef ^ ModDataType character(ChanLen) Abbr - - - "Module name abbreviation" - +typedef ^ ^ IntKi iMod - 0 - "Module index in array of modules" - typedef ^ ^ IntKi ID - 0 - "Module identification number" - -typedef ^ ^ character(ChanLen) Abbr - - - "Module name abbreviation" - typedef ^ ^ IntKi Ins - 0 - "Module instance number" - -typedef ^ ^ logical IsTC - F - "Flag indicating module is part of tight coupling" - -typedef ^ ^ R8Ki DT - 0 - "Module time step" - typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - -typedef ^ ^ IntKi ixs :: - - "index array mapping local x vector to global x vector" - -typedef ^ ^ IntKi ius :: - - "index array mapping local u vector to global u vector" - -typedef ^ ^ IntKi iys :: - - "index array mapping local y vector to global y vector" - -typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - -typedef ^ ^ IntKi SrcMaps : - - "Indices of mappings where module is the source" -typedef ^ ^ IntKi DstMaps : - - "Indices of mappings where module is the destination" +typedef ^ ^ R8Ki DT - 0 - "Module time step" - +typedef ^ ^ ModVarsType Vars - - - "Module variables type" - +typedef ^ ^ ModLinType Lin - - - "Module linearization arrays and matrices" diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_mesh.txt b/modules/nwtc-library/src/Registry_NWTC_Library_mesh.txt index 0cb2a1ecf3..d960ac8230 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_mesh.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_mesh.txt @@ -37,4 +37,3 @@ typedef ^ ^ R8Ki LoadLn2_F 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/openfast-library/CMakeLists.txt b/modules/openfast-library/CMakeLists.txt index e4ac77521c..3141922e1e 100644 --- a/modules/openfast-library/CMakeLists.txt +++ b/modules/openfast-library/CMakeLists.txt @@ -15,6 +15,7 @@ # if (GENERATE_TYPES) + generate_f90_types(src/Glue_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/Glue_Types.f90 -noextrap) generate_f90_types(src/FAST_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/FAST_Types.f90 -noextrap) endif() @@ -38,6 +39,7 @@ elseif (${_compiler_id} MATCHES "^INTEL" AND ${_build_type} STREQUAL "RELEASE" A endif() add_library(openfast_prelib STATIC + src/Glue_Types.f90 src/FAST_Types.f90 ) target_link_libraries(openfast_prelib @@ -66,12 +68,13 @@ target_link_libraries(openfast_prelib ) add_library(openfast_postlib STATIC - src/FAST_Lin.f90 src/FAST_Mods.f90 src/FAST_Subs.f90 - src/FAST_Solver.f90 - src/FAST_SS_Subs.f90 - src/FAST_SS_Solver.f90 + src/FAST_Funcs.f90 + src/FAST_ModGlue.f90 + src/FAST_Mapping.f90 + src/FAST_AeroMap.f90 + src/FAST_SolverTC.f90 ) target_link_libraries(openfast_postlib openfast_prelib extinflowlib scfastlib) target_include_directories(openfast_postlib PUBLIC diff --git a/modules/openfast-library/src/FAST_AeroMap.f90 b/modules/openfast-library/src/FAST_AeroMap.f90 new file mode 100644 index 0000000000..8fdf69a5e5 --- /dev/null +++ b/modules/openfast-library/src/FAST_AeroMap.f90 @@ -0,0 +1,1252 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2024 Envision Energy USA, National Renewable Energy Laboratory +! +! This file is part of FAST. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +!********************************************************************************************************************************** +!> This module contains the routines used by FAST to solve input-output equations and to advance states. + +module FAST_AeroMap + +use FAST_ModTypes +use FAST_Types +use FAST_Funcs +use FAST_Mapping +use FAST_ModGlue + +use FAST_Subs + +implicit none + +real(DbKi), parameter :: SS_t_global = 0.0_DbKi +real(DbKi), parameter :: UJacSclFact_x = 1.0d3 + +logical, parameter :: output_debugging = .false. +integer(IntKi), parameter :: iModStruct = 1 +integer(IntKi), parameter :: iModAero = 2 +integer(IntKi), private, parameter :: iED = 1 + +contains + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! DRIVER ROUTINE (runs + ends simulation) +! Put here so that we can call from either stand-alone code or from the ENFAST executable. +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +subroutine FAST_RunSteadyStateDriver(Turbine) + type(FAST_TurbineType), intent(inout) :: Turbine !< all data for one instance of a turbine + + integer(IntKi) :: ErrStat !< Error status of the operation + character(ErrMsgLen) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ProgName = TRIM(FAST_Ver%Name)//' Aero Map' + FAST_Ver%Name = ProgName + + call FAST_AeroMapDriver(Turbine%m_Glue%AM, Turbine%m_Glue, Turbine%p_FAST, Turbine%m_FAST, Turbine%y_FAST, Turbine, ErrStat, ErrMsg) + call CheckError(ErrStat, ErrMsg, 'FAST_AeroMapDriver') + + call ExitThisProgram_T(Turbine, ErrID_None, .true.) + +contains + subroutine CheckError(ErrID, Msg, SimMsg) + integer(IntKi), intent(in) :: ErrID ! The error identifier (ErrStat) + character(*), intent(in) :: Msg ! The error message (ErrMsg) + character(*), intent(in) :: SimMsg ! a message describing the location of the error + if (ErrID /= ErrID_None) then + call WrScr(NewLine//TRIM(Msg)//NewLine) + if (ErrID >= AbortErrLev) then + call ExitThisProgram_T(Turbine, ErrID, .true., SimMsg) + end if + end if + end subroutine CheckError +end subroutine + +subroutine FAST_AeroMapDriver(AM, m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) + use InflowWind_IO, only: IfW_SteadyFlowField_Init + type(Glue_AeroMap), intent(inout) :: AM !< AeroMap data + type(Glue_MiscVarType), intent(inout) :: m !< MiscVars for the glue code + 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 + type(FAST_TurbineType), intent(inout) :: T !< all data for one instance of a turbine + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + + character(*), parameter :: RoutineName = 'FAST_AeroMapDriver' + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: ErrStat2 + logical, parameter :: CompAeroMaps = .true. + real(DbKi), parameter :: t_initial = 0.0_DbKi + integer(IntKi) :: iModED, iModBD, iModAD, iModOrder(2) + integer(IntKi) :: i + integer(IntKi) :: JacSize + integer(IntKi) :: n_case !< loop counter + real(DbKi) :: n_global + real(ReKi), allocatable :: UnusedAry(:) + type(AeroMapCase) :: CaseDataTmp ! tsr, windSpeed, pitch, and rotor speed for this case (to try a different operating point first) + integer(IntKi) :: NStatus + character(MaxWrScrLen), parameter :: BlankLine = " " + + ErrStat = ErrID_None + ErrMsg = '' + + !---------------------------------------------------------------------------- + ! Initialization + !---------------------------------------------------------------------------- + + ! Set Turbine ID + T%TurbID = 1 + + ! Initialize linearization file number (will be incremented before use) + AM%LinFileNum = 0 + + ! Standard Turbine initialization + call FAST_InitializeAll(t_initial, T%m_Glue, T%p_FAST, T%y_FAST, T%m_FAST, & + T%ED, T%SED, T%BD, T%SrvD, T%AD, T%ADsk, & + T%ExtLd, T%IfW, T%ExtInfw, T%SC_DX, & + T%SeaSt, T%HD, T%SD, T%ExtPtfm, T%MAP, & + T%FEAM, T%MD, T%Orca, T%IceF, T%IceD, & + T%MeshMapData, CompAeroMaps, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Initialize module data transfer mappings + call FAST_InitMappings(m%Mappings, m%ModData, T, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Initialize steady flow field in AeroDyn + call IfW_SteadyFlowField_Init(T%AD%p%FlowField, & + RefHt=100.0_ReKi, & + HWindSpeed=8.0_ReKi, & + PLExp=0.0_ReKi, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + !---------------------------------------------------------------------------- + ! Module Order + !---------------------------------------------------------------------------- + + ! Get indices of modules that are used by Aero Mapping (first instance only) + iModED = 0; iModBD = 0; iModAD = 0 + do i = 1, size(m%ModData) + associate (ModData => m%ModData(i)) + if (ModData%Ins == 1) then + select case (ModData%ID) + case (Module_ED) + iModED = i + case (Module_BD) + iModBD = i + case (Module_AD) + iModAD = i + end select + end if + end associate + end do + + ! If BeamDyn is active + if (iModBD > 0) then + iModOrder = [iModBD, iModAD] + else if (iModED > 0) then + iModOrder = [iModED, iModAD] + end if + + !---------------------------------------------------------------------------- + ! Build AeroMap module + !---------------------------------------------------------------------------- + + ! Generate index for variables with AeroMap flag + call Glue_CombineModules(AM%Mod, m%ModData, m%Mappings, iModOrder, VF_AeroMap, & + .true., ErrStat2, ErrMsg2, Name="AeroMap") + if (Failed()) return + + ! Loop through modules in AM module + do i = 1, size(AM%Mod%ModData) + associate (ModData => AM%Mod%ModData(i)) + + ! Copy current state to predicted state + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_NEWCOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Copy current inputs to previous inputs + call FAST_CopyInput(ModData, T, INPUT_CURR, INPUT_PREV, MESH_NEWCOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + end associate + end do + + !---------------------------------------------------------------------------- + ! Allocation + !---------------------------------------------------------------------------- + + ! Allocate components of the Jacobian matrix + call AllocAry(AM%Jac11, AM%Mod%Vars%Nx, AM%Mod%Vars%Nx, 'Jac11', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%Jac12, AM%Mod%Vars%Nx, AM%Mod%Vars%Nu, 'Jac12', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%Jac21, AM%Mod%Vars%Nu, AM%Mod%Vars%Nx, 'Jac21', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%Jac22, AM%Mod%Vars%Nu, AM%Mod%Vars%Nu, 'Jac22', ErrStat2, ErrMsg2); if (Failed()) return + + ! Jacobian size is number of states plus number of inputs + JacSize = AM%Mod%Vars%Nx + AM%Mod%Vars%Nu + + ! Allocate Jacobian pivot vector + call AllocAry(AM%JacPivot, JacSize, 'Pivot array for Jacobian LU decomposition', ErrStat2, ErrMsg2); if (Failed()) return + + ! Storage for residual and solution delta + call AllocAry(AM%Residual, JacSize, 'Residual', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%SolveDelta, JacSize, 'SolveDelta', ErrStat2, ErrMsg2); if (Failed()) return + + ! Allocate Jacobian matrix + call AllocAry(AM%Mod%Lin%J, JacSize, JacSize, 'J', ErrStat2, ErrMsg2); if (Failed()) return + + ! Allocate Idx Jacobian storage + call AllocAry(AM%Mod%Lin%dXdy, AM%Mod%Vars%Nx, AM%Mod%Vars%Ny, 'dXdy', ErrStat2, ErrMsg2); if (Failed()) return + + ! Allocate arrays to store inputs + call AllocAry(AM%u1, AM%Mod%Vars%Nu, 'u1', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AM%u2, AM%Mod%Vars%Nu, 'u2', ErrStat2, ErrMsg2); if (Failed()) return + + ! Move hub orientation matrices to AeroMap structure + call move_alloc(T%MeshMapData%HubOrient, AM%HubOrientation) + + !---------------------------------------------------------------------------- + ! AeroMap structure initialization + !---------------------------------------------------------------------------- + + ! Jacobian scaling factor + AM%JacScale = real(p_FAST%UJacSclFact, R8Ki) + + ! Set tolerance so the error doesn't need to be divided by size of array later + AM%SolveTolerance = p_FAST%tolerSquared*JacSize**2 + + ! Allocate cases + allocate (AM%Cases(p_FAST%NumSSCases), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating AeroMap cases", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Populate case data + do n_case = 1, p_FAST%NumSSCases + if (p_FAST%WindSpeedOrTSR == 1) then + AM%Cases(n_case)%WindSpeed = p_FAST%WS_TSR(n_case) + AM%Cases(n_case)%TSR = p_FAST%RotSpeed(n_case)*T%AD%p%rotors(1)%BEMT%rTipFixMax/AM%Cases(n_case)%WindSpeed + else + AM%Cases(n_case)%TSR = p_FAST%WS_TSR(n_case) + AM%Cases(n_case)%WindSpeed = p_FAST%RotSpeed(n_case)*T%AD%p%rotors(1)%BEMT%rTipFixMax/AM%Cases(n_case)%TSR + end if + AM%Cases(n_case)%Pitch = p_FAST%Pitch(n_case) + AM%Cases(n_case)%RotSpeed = p_FAST%RotSpeed(n_case) + end do + + !---------------------------------------------------------------------------- + ! Calculate steady-state solution for each case + !---------------------------------------------------------------------------- + + ! how often do we inform the user which case we are on? + NStatus = min(100, p_FAST%NumSSCases/100 + 1) ! at least 100 every 100 cases or 100 times per simulation + call WrScr(NewLine) + + ! Loop through Aero Map cases + do n_case = 1, p_FAST%NumSSCases + + ! If status should be written to screen + if (n_case == 1 .or. n_case == p_FAST%NumSSCases .or. mod(n_case, NStatus) == 0) then + call WrOver(' Case '//trim(Num2LStr(n_case))//' of '//trim(Num2LStr(p_FAST%NumSSCases))) + end if + + ! Call steady-state solve for this pitch and rotor speed + call SS_Solve(AM, m, m%Mappings, AM%Cases(n_case), p_FAST, y_FAST, m_FAST, T, ErrStat2, ErrMsg2) + + ! we didn't converge; let's try a different operating point and see if that helps: + if (ErrStat2 >= ErrID_Severe) then + + ! Create copy of case data for second attempt + CaseDataTmp = AM%Cases(n_case) + + ! Modify pitch, TSR, and WindSpeed + CaseDataTmp%Pitch = CaseDataTmp%Pitch*0.5_ReKi + CaseDataTmp%TSR = CaseDataTmp%TSR*0.5_ReKi + CaseDataTmp%WindSpeed = CaseDataTmp%WindSpeed*0.5_ReKi + + ! Write message about retrying case + call WrScr('Retrying case '//trim(Num2LStr(n_case))//', first trying to get a better initial guess. Average error is '// & + trim(Num2LStr(y_FAST%DriverWriteOutput(SS_Indx_Err)))//'.') + + call SS_Solve(AM, m, m%Mappings, CaseDataTmp, p_FAST, y_FAST, m_FAST, T, ErrStat2, ErrMsg2) + + ! if that worked, try the real case again: + if (ErrStat2 < AbortErrLev) then + ! call SS_Solve(m, AM%Cases(n_case), p_FAST, y_FAST, m_FAST, T%ED, T%BD, T%AD, T%MeshMapData, T, ErrStat2, ErrMsg2) + call WrOver(BlankLine) + end if + + end if + + if (ErrStat2 > ErrID_None) then + ErrMsg2 = trim(ErrMsg2)//" case "//trim(Num2LStr(n_case))// & + ' (tsr='//trim(Num2LStr(AM%Cases(n_case)%tsr))// & + ', wind speed='//trim(Num2LStr(AM%Cases(n_case)%windSpeed))//' m/s'// & + ', pitch='//trim(num2lstr(AM%Cases(n_case)%pitch*R2D))//' deg'// & + ', rotor speed='//trim(num2lstr(AM%Cases(n_case)%RotSpeed*RPS2RPM))//' rpm)' + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if + + !------------------------------------------------------------------------- + ! Write results to file + !------------------------------------------------------------------------- + + n_global = real(n_case, DbKi) ! n_global is double-precision so that we can reuse existing code. + + call WrOutputLine(n_global, p_FAST, y_FAST, UnusedAry, UnusedAry, T%ED%y, UnusedAry, & + T%AD%y, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, & + UnusedAry, UnusedAry, UnusedAry, UnusedAry, T%IceD%y, T%BD%y, ErrStat2, ErrMsg2) + if (Failed()) return + + !------------------------------------------------------------------------- + ! Write errors to screen + !------------------------------------------------------------------------- + + if (ErrStat > ErrID_None) then + call WrScr(trim(ErrMsg)) + call WrScr("") + ErrStat = ErrID_None + ErrMsg = "" + end if + + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine performs the Input-Output solve for the steady-state solver. +!! Note that this has been customized for the physics in the problems and is not a general solution. +subroutine SS_Solve(AM, m, Mappings, caseData, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) + type(Glue_AeroMap), intent(inout) :: AM !< AeroMap data + type(Glue_MiscVarType), intent(inout) :: m !< Miscellaneous variables + type(MappingType), intent(inout) :: Mappings(:) !< Transfer mappings + type(AeroMapCase), intent(in) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case + type(FAST_ParameterType), intent(in) :: p_FAST !< Glue-code simulation parameters + type(FAST_OutputFileType), intent(inout) :: y_FAST !< Glue-code output file values + type(FAST_MiscVarType), intent(inout) :: m_FAST !< Miscellaneous variables + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'SS_Solve' + integer(IntKi) :: ErrStat2 ! temporary Error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + + !bjj: store these so that we don't reallocate every time? + real(R8Ki) :: err + real(R8Ki) :: err_prev + real(R8Ki), allocatable :: u(:) + real(R8Ki), parameter :: reduction_factor = 0.1_R8Ki + + integer(IntKi) :: nb ! loop counter (blade number) + integer(IntKi) :: MaxIter ! maximum number of iterations + integer(IntKi) :: iter ! Input-output-solve iteration counter + integer(IntKi) :: i, j + integer(IntKi) :: nx ! Number of state variables in Jacobian + + logical :: GetWriteOutput ! flag to determine if we need WriteOutputs from this call to CalcOutput + + !bjj: note, that this routine may have a problem if there is remapping done + + ErrStat = ErrID_None + ErrMsg = "" + + !---------------------------------------------------------------------------- + ! Some record keeping stuff: + !---------------------------------------------------------------------------- + + nx = AM%Mod%Vars%Nx + + ! Set the rotor speed in ElastoDyn + T%ED%x(iED,STATE_CURR)%QDT(p_FAST%GearBox_Index) = caseData%RotSpeed + + ! Set prescribed inputs from case data + call SS_SetPrescribedInputs(caseData, p_FAST, y_FAST, m_FAST, T%ED, T%BD, T%AD) + + ! Copy inputs from current to previous index + do i = 1, size(AM%Mod%ModData) + call FAST_CopyInput(AM%Mod%ModData(i), T, INPUT_CURR, INPUT_PREV, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + + iter = 0 + err = 1.0E3 + err_prev = err + + y_FAST%DriverWriteOutput(SS_Indx_Err) = -1 + y_FAST%DriverWriteOutput(SS_Indx_Iter) = 0 + y_FAST%DriverWriteOutput(SS_Indx_TSR) = caseData%tsr + y_FAST%DriverWriteOutput(SS_Indx_WS) = caseData%windSpeed + y_FAST%DriverWriteOutput(SS_Indx_Pitch) = caseData%Pitch*R2D + y_FAST%DriverWriteOutput(SS_Indx_RotSpeed) = caseData%RotSpeed*RPS2RPM + + MaxIter = p_FAST%KMax + 1 ! adding 1 here so that we get the error calculated correctly when we hit the max iteration + do + + !------------------------------------------------------------------------- + ! Calculate outputs, based on inputs at this time + !------------------------------------------------------------------------- + + ! Set GetWriteOutput flag true if not the first iteration + GetWriteOutput = iter > 0 + + !----------------------------------------- + ! Calculate ElastoDyn / BeamDyn output + !----------------------------------------- + + call FAST_CalcOutput(AM%Mod%ModData(1), Mappings, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + !----------------------------------------- + ! AeroDyn InputSolve + !----------------------------------------- + + ! If first iteration + if (iter == 0) then + + ! Perform AeroDyn input solve to get initial guess from structural module + ! (this ensures that the pitch is accounted for in the fixed aero-map solve:): + call SS_AD_InputSolve(AM, Mappings, INPUT_CURR, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_AD_InputSolve_OtherBlades(AM, INPUT_CURR, T) + + ! Get initial states + call SS_GetStates(AM, AM%Mod%Lin%x, INPUT_CURR, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Get initial inputs + call SS_GetInputs(AM, AM%u1, INPUT_CURR, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + end if + + !----------------------------------------- + ! Calculate AeroDyn Output + !----------------------------------------- + + call FAST_CalcOutput(AM%Mod%ModData(2), Mappings, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) then + call ResetInputsAndStates() + return + end if + + ! If iteration is at or above maximum iteration, exit loop + if (iter >= MaxIter) exit + + !------------------------------------------------------------------------------------------------- + ! Calculate residual and the Jacobian + ! (note that we don't want to change module%Input(1), here) + ! Also, the residual uses values from y_FAST, so do this before calculating the jacobian + !------------------------------------------------------------------------------------------------- + + call SS_BuildResidual(AM, caseData, Mappings, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) then + call ResetInputsAndStates() + return + end if + + ! If Jacobian needs to be recalculated + if (mod(iter, p_FAST%N_UJac) == 0) then + call SS_BuildJacobian(AM, caseData, Mappings, p_FAST, y_FAST, m_FAST, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) then + call ResetInputsAndStates() + return + end if + end if + + !------------------------------------------------------------------------- + ! Solve for delta u: J*SolveDelta = -Residual + ! using the LAPACK routine + !------------------------------------------------------------------------- + + ! Copy negative of residual into solve + AM%SolveDelta = -AM%Residual + + ! Solve for changes in states and inputs + call LAPACK_getrs(TRANS="N", N=size(AM%Mod%Lin%J, 1), A=AM%Mod%Lin%J, & + IPIV=AM%JacPivot, B=AM%SolveDelta, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + !------------------------------------------------------------------------- + ! Check for error, update inputs if necessary, and iterate again + !------------------------------------------------------------------------- + + ! Save previous error + err_prev = err + + ! Calculate new error + err = dot_product(AM%SolveDelta, AM%SolveDelta) + + ! Store normalized error in output + y_FAST%DriverWriteOutput(SS_Indx_Err) = sqrt(err)/size(AM%Mod%Lin%J, 1) + + ! Remove conditioning from solution vector + call PostconditionInputDelta(AM%Mod%Vars, AM%SolveDelta(nx + 1:), AM%JacScale) + + ! If error is below tolerance + if (err <= AM%SolveTolerance) then + if (iter == 0) then ! the error will be incorrect in this instance, but the outputs will be better + MaxIter = iter + else + exit + end if + end if + + if (iter >= p_FAST%KMax) exit + if (iter > 5 .and. err > 1.0E35) exit ! this is obviously not converging. Let's try something else. + + !------------------------------------------------------------------------- + ! Modify inputs and states for next iteration + !------------------------------------------------------------------------- + + ! If current error is greater than previous error (solution diverging), + ! reduce delta (take a smaller step) + if (err > err_prev) then + AM%SolveDelta = AM%SolveDelta*reduction_factor + err_prev = err_prev*reduction_factor + end if + + ! Update states and inputs based on solution + call SS_UpdateInputsStates(AM, AM%SolveDelta, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Increment iteration counter and set it in write output + iter = iter + 1 + y_FAST%DriverWriteOutput(SS_Indx_Iter) = iter + + end do ! K + + !TODO + if (p_FAST%CompElast == Module_BD) then + ! this doesn't actually get the correct hub point load from BD, but we'll get some outputs: + ! call ED_CalcOutput(SS_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, ED%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if + + call ResetInputsAndStates() + +contains + subroutine ResetInputsAndStates() + + if (err > AM%SolveTolerance) then + + call SetErrStat(ErrID_Severe, 'Steady-state solver did not converge.', ErrStat, ErrMsg, RoutineName) + + ! if we didn't get close on the solution, we should reset the states and inputs because they very well could + ! lead to numerical issues on the next iteration. Here, set the initial values to 0: + if (err > 100.0) then + + ! because loads occasionally get very large when it fails, manually set these to zero (otherwise + ! roundoff can lead to non-zero values with the method below, which is most useful for states) + if (p_FAST%CompElast == Module_BD) then + do iter = 1, p_FAST%nBeams + T%BD%Input(1, iter)%DistrLoad%Force = 0.0_ReKi + T%BD%Input(1, iter)%DistrLoad%Moment = 0.0_ReKi + end do + end if + + ! Find the values we have been modifying (in u... continuous states and inputs) + call SS_GetStates(AM, AM%SolveDelta(:nx), STATE_CURR, T, ErrStat2, ErrMsg2) + call SS_GetInputs(AM, AM%SolveDelta(nx + 1:), INPUT_CURR, T, ErrStat2, ErrMsg2) + + ! Reset them to 0 (by adding -u) + AM%SolveDelta = -AM%SolveDelta + call SS_UpdateInputsStates(AM, AM%SolveDelta, T, ErrStat2, ErrMsg2) + end if + end if + + end subroutine ResetInputsAndStates + +end subroutine SS_Solve + +subroutine PreconditionInputResidual(Vars, u_residual, JacScale) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: u_residual(:) + real(R8Ki), intent(in) :: JacScale + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i)) + if (MV_IsLoad(Var)) then + u_residual(Var%iLoc(1):Var%iLoc(2)) = u_residual(Var%iLoc(1):Var%iLoc(2))/JacScale + end if + end associate + end do +end subroutine + +subroutine PostconditionInputDelta(Vars, u_delta, JacScale) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: u_delta(:) + real(R8Ki), intent(in) :: JacScale + integer(IntKi) :: i + do i = 1, size(Vars%u) + associate (Var => Vars%u(i)) + if (MV_IsLoad(Var)) then + u_delta(Var%iLoc(1):Var%iLoc(2)) = u_delta(Var%iLoc(1):Var%iLoc(2))*JacScale + end if + end associate + end do +end subroutine + +subroutine SS_UpdateInputsStates(AM, delta, T, ErrStat, ErrMsg) + use ElastoDyn_IO, only: DOF_BF, DOF_BE + type(Glue_AeroMap), intent(inout) :: AM !< AeroMap data + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + real(R8Ki), intent(in) :: delta(:) !< Change in state and input arrays + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'SS_UpdateInputsStates' + integer(IntKi) :: ErrStat2 ! temporary Error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + integer(IntKi) :: i, j + + ! Add change in inputs to current inputs + call MV_AddDelta(AM%Mod%Vars%u, delta(AM%Mod%Vars%Nx + 1:), AM%u1) + + ! Add change in continuous states to current states + call MV_AddDelta(AM%Mod%Vars%x, delta(:AM%Mod%Vars%Nx), AM%Mod%Lin%x) + + ! Update states and inputs in module + do i = 1, size(AM%Mod%ModData) + associate (ModData => AM%Mod%ModData(i)) + + ! Populate input and state values in module + call FAST_SetOP(ModData, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & + u_op=ModData%Lin%u, u_glue=AM%u1, & + x_op=ModData%Lin%x, x_glue=AM%Mod%Lin%x) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Select based on module + select case (ModData%ID) + case (Module_ED) + + ! Copy blade1 flap and edge states to other blades + do j = 2, T%ED%p(iED)%NumBl + T%ED%x(iED,STATE_CURR)%QT(DOF_BF(j, 1)) = T%ED%x(iED,STATE_CURR)%QT(DOF_BF(1, 1)) + T%ED%x(iED,STATE_CURR)%QT(DOF_BF(j, 2)) = T%ED%x(iED,STATE_CURR)%QT(DOF_BF(1, 2)) + T%ED%x(iED,STATE_CURR)%QT(DOF_BE(j, 1)) = T%ED%x(iED,STATE_CURR)%QT(DOF_BE(1, 1)) + end do + + ! Set velocities to zero + do j = 1, T%ED%p(iED)%NumBl + T%ED%x(iED,STATE_CURR)%QDT(DOF_BF(j, 1)) = 0.0_R8Ki + T%ED%x(iED,STATE_CURR)%QDT(DOF_BF(j, 2)) = 0.0_R8Ki + T%ED%x(iED,STATE_CURR)%QDT(DOF_BE(j, 1)) = 0.0_R8Ki + end do + + ! Transfer loads from ED blade 1 to other blades + call SS_ED_InputSolve_OtherBlades(AM, INPUT_CURR, T) + + case (Module_BD) + ! TODO: Copy B1 states to other blades + + ! Transfer loads from BD blade 1 to other blades + call SS_BD_InputSolve_OtherBlades(AM, INPUT_CURR, T) + + case (Module_AD) + + ! Transfer AD blade 1 motion to other blades + call SS_AD_InputSolve_OtherBlades(AM, INPUT_CURR, T) + + end select + end associate + end do + +end subroutine + +subroutine SS_BuildJacobian(AM, caseData, Mappings, p_FAST, y_FAST, m_FAST, T, ErrStat, ErrMsg) + type(Glue_AeroMap), intent(inout) :: AM !< AeroMap module + type(MappingType), intent(inout) :: Mappings(:) !< Module mapping + type(AeroMapCase), intent(in) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case + 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(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(OUT) :: ErrStat !< Error status of the operation + character(*), intent(OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'SS_BuildJacobian' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMSg2 + character(1024) :: LinRootName + integer(IntKi) :: i, j, k, c, r, iRow(2), iCol(2), iLoc(2) + integer(IntKi) :: nx ! Number of states + integer(IntKi) :: Un + logical :: RowIsLoad, ColIsLoad + + ErrStat = ErrID_None + ErrMsg = "" + + ! Set number of states + nx = AM%Mod%Vars%Nx + + ! If output debugging is requested + if (output_debugging) then + + ! Get unit number for output files + call GetNewUnit(Un, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Build linearization root name + AM%LinFileNum = AM%LinFileNum + 1 + LinRootName = trim(p_FAST%OutFileRoot)//'.'//trim(Num2LStr(AM%LinFileNum)) + + ! These values get printed in the linearization output files, so we'll set them here: + y_FAST%Lin%WindSpeed = caseData%WindSpeed + y_FAST%Lin%RotSpeed = caseData%RotSpeed + y_FAST%Lin%Azimuth = 0.0_ReKi + end if + + ! Initialize Jacobian + AM%Mod%Lin%J = 0.0_R8Ki + + !---------------------------------------------------------------------------- + ! dXdy + !---------------------------------------------------------------------------- + + AM%Mod%Lin%dXdy = 0.0_R8Ki + + !---------------------------------------------------------------------------- + ! Module Jacobians + !---------------------------------------------------------------------------- + + ! Loop through modules + do i = 1, size(AM%Mod%ModData) + associate (ModData => AM%Mod%ModData(i)) + + ! Calculate dYdu and dXdu + call FAST_JacobianPInput(ModData, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & + dYdu=ModData%Lin%dYdu, dYdu_glue=AM%Mod%Lin%dYdu, & + dXdu=ModData%Lin%dXdu, dXdu_glue=AM%Mod%Lin%dXdu) + if (Failed()) return + + ! Calculate dYdx and dXdx + call FAST_JacobianPContState(ModData, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & + dYdx=ModData%Lin%dYdx, dYdx_glue=AM%Mod%Lin%dYdx, & + dXdx=ModData%Lin%dXdx, dXdx_glue=AM%Mod%Lin%dXdx) + if (Failed()) return + + ! If output debugging requested + if (output_debugging) then + + ! Calculate operating point values + call FAST_GetOP(ModData, SS_t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & + u_op=ModData%Lin%u, u_glue=AM%Mod%Lin%u, & + y_op=ModData%Lin%y, y_glue=AM%Mod%Lin%y, & + x_op=ModData%Lin%x, x_glue=AM%Mod%Lin%x, & + dx_op=ModData%Lin%dx, dx_glue=AM%Mod%Lin%dx) + if (Failed()) return + + ! Write linearization matrices + call CalcWriteLinearMatrices(ModData%Vars, ModData%Lin, p_FAST, y_FAST, SS_t_global, Un, & + LinRootName, VF_AeroMap, ErrStat2, ErrMsg2, ModData%Abbr, CalcGlue=.false.) + if (Failed()) return + + end if + + ! If this module is BeamDyn, calculate dxdotdy + if (ModData%ID == Module_BD) then + + ! TODO: implement BeamDyn + ! NOTE that this implies that the FEA nodes (states) are the same as the output nodes!!!! (note that we have overlapping nodes at the element end points) + ! r = 1 + ! do i = 2, BD%p(k)%node_total ! the first node isn't technically a state + ! c = (BD%p(k)%NdIndx(i) - 1)*3 + 1 ! BldMeshNode = BD%p(k)%NdIndx(i) + + ! !dxdotdy(r:r+2,c:c+2) = SkewSymMat( [p_FAST%RotSpeed, 0.0_ReKi, 0.0_ReKi] ) + ! dxdotdy(r + 2, c + 1) = caseData%RotSpeed + ! dxdotdy(r + 1, c + 2) = -caseData%RotSpeed + + ! ! derivative + ! dxdotdy(r + nx + 1, c + 1) = -OmegaSquared + ! dxdotdy(r + nx + 2, c + 2) = -OmegaSquared + + ! r = r + BD%p(k)%dof_node + ! end do + end if + + end associate + end do + + !---------------------------------------------------------------------------- + ! Glue Jacobians + !---------------------------------------------------------------------------- + + AM%Mod%Lin%dUdy = 0.0_R8Ki + call Eye2D(AM%Mod%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_LinearizeMappings(AM%Mod, Mappings, T, ErrStat2, ErrMsg2) + if (Failed()) return + + !---------------------------------------------------------------------------- + ! Form Jacobian matrix + !---------------------------------------------------------------------------- + + ! Calculate Jacobian block 11 = dX/dx - dX/dy * dY/dx + AM%Jac11 = AM%Mod%Lin%dXdx + call LAPACK_GEMM('N', 'N', -1.0_R8Ki, AM%Mod%Lin%dXdy, AM%Mod%Lin%dYdx, 1.0_R8Ki, AM%Jac11, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Calculate Jacobian block 12 = dX/du - dX/dy * dY/du + AM%Jac12 = AM%Mod%Lin%dXdu + call LAPACK_GEMM('N', 'N', -1.0_R8Ki, AM%Mod%Lin%dXdy, AM%Mod%Lin%dYdu, 1.0_R8Ki, AM%Jac12, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Calculate Jacobian block 21 = dU/dy * dY/dx + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, AM%Mod%Lin%dUdy, AM%Mod%Lin%dYdx, 0.0_R8Ki, AM%Jac21, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Calculate Jacobian block 22 = dU/du + dU/dy * dY/du + AM%Jac22 = AM%Mod%Lin%dUdu + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, AM%Mod%Lin%dUdy, AM%Mod%Lin%dYdu, 1.0_R8Ki, AM%Jac22, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Assemble blocks to form full Jacobian + AM%Mod%Lin%J(:nx, :nx) = AM%Jac11 + AM%Mod%Lin%J(:nx, nx + 1:) = AM%Jac12 + AM%Mod%Lin%J(nx + 1:, :nx) = AM%Jac21 + AM%Mod%Lin%J(nx + 1:, nx + 1:) = AM%Jac22 + + ! If output debugging is enabled, write combined matrices and Jacobian + if (output_debugging) then + call CalcWriteLinearMatrices(AM%Mod%Vars, AM%Mod%Lin, p_FAST, y_FAST, SS_t_global, Un, & + LinRootName, VF_AeroMap, ErrStat2, ErrMsg2, CalcGlue=.false.) + if (Failed()) return + end if + + !---------------------------------------------------------------------------- + ! Condition Jacobian matrix + !---------------------------------------------------------------------------- + + ! Note: AM%JacScale is a scaling factor that gets similar magnitudes between loads and accelerations... + + associate (J => AM%Mod%Lin%J) + + ! Loop through inputs + do r = 1, size(AM%Mod%Vars%u) + iLoc = AM%Mod%Vars%u(r)%iLoc + nx + if (MV_IsLoad(AM%Mod%Vars%u(r))) then + ! Column is motion (state), row is load + J(iLoc(1):iLoc(2), 1:nx) = J(iLoc(1):iLoc(2), 1:nx)/AM%JacScale + ! Row is motion (state), column is load + J(1:nx, iLoc(1):iLoc(2)) = J(1:nx, iLoc(1):iLoc(2))*AM%JacScale + end if + end do + + ! Loop through input vars as columns + do c = 1, size(AM%Mod%Vars%u) + iCol = AM%Mod%Vars%u(c)%iLoc + nx + ColIsLoad = MV_IsLoad(AM%Mod%Vars%u(c)) + + ! Loop through input vars as rows + do r = 1, size(AM%Mod%Vars%u) + iRow = AM%Mod%Vars%u(r)%iLoc + nx + RowIsLoad = MV_IsLoad(AM%Mod%Vars%u(r)) + + if ((.not. RowIsLoad) .and. ColIsLoad) then ! Row is a motion, Col is a load + J(iRow(1):iRow(2), iCol(1):iCol(2)) = J(iRow(1):iRow(2), iCol(1):iCol(2))*AM%JacScale + else if (RowIsLoad .and. (.not. ColIsLoad)) then ! Row is a load, Col is a motion + J(iRow(1):iRow(2), iCol(1):iCol(2)) = J(iRow(1):iRow(2), iCol(1):iCol(2))/AM%JacScale + end if + end do + end do + + end associate + + !---------------------------------------------------------------------------- + ! Factor Jacobian matrix + ! Get the LU decomposition of this matrix using a LAPACK routine: + ! The result is of the form Jmat = P * L * U + !---------------------------------------------------------------------------- + + call LAPACK_getrf(M=size(AM%Mod%Lin%J, 1), N=size(AM%Mod%Lin%J, 2), & + A=AM%Mod%Lin%J, IPIV=AM%JacPivot, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + +contains + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call Cleanup() + end function + + subroutine Cleanup() + if (Un > 0) close (Un) + end subroutine Cleanup + +end subroutine SS_BuildJacobian + +subroutine SS_BuildResidual(AM, caseData, Mappings, T, ErrStat, ErrMsg) + type(Glue_AeroMap), intent(inout) :: AM !< AeroMap data + type(AeroMapCase), intent(IN) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case + type(MappingType), intent(inout) :: Mappings(:) !< Module mapping + type(FAST_TurbineType), intent(INOUT) :: T !< Turbine type + integer(IntKi), intent(OUT) :: ErrStat !< Error status of the operation + character(*), intent(OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'SS_BuildResidual' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, iVarMod(2), iVarGbl(2) + + integer, parameter :: StateIndex = STATE_PRED + + ErrStat = ErrID_None + ErrMsg = "" + + ! Pointers to parts of residual array + associate (xResidual => AM%Residual(:AM%Mod%Vars%Nx), & ! States residual + uResidual => AM%Residual(AM%Mod%Vars%Nx + 1:)) ! Inputs residual + + ! Note: prescribed inputs are already set in both INPUT_CURR and INPUT_PREV so we can ignore them here + call SS_CalcContStateDeriv(AM, caseData, INPUT_CURR, xResidual, T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Note that we don't need to calculate the inputs on more than p_FAST%NumBl_Lin blades because we are only using them to compute the SS_GetInputs + call SS_GetCalculatedInputs(AM, AM%u2, Mappings, T, ErrStat2, ErrMsg2) ! calculate new inputs and store in InputIndex=2 + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Calculate difference between prescribed and calculated inputs + call MV_ComputeDiff(AM%Mod%Vars%u, AM%u1, AM%u2, uResidual) + + ! Condition residual for solve + call PreconditionInputResidual(AM%Mod%Vars, uResidual, AM%JacScale) + end associate + +end subroutine + +!------------------------------------------------------------------------------- + +!> SS_BD_InputSolve_OtherBlades sets the blade-load ElastoDyn inputs from blade 1 to the other blades. +subroutine SS_BD_InputSolve_OtherBlades(AM, InputIndex, T) + type(Glue_AeroMap), intent(in) :: AM !< AeroMap data + integer(IntKi), intent(in) :: InputIndex !< Input index to transfer + type(FAST_TurbineType), intent(INOUT) :: T !< Turbine type + integer(IntKi) :: j, k + do k = 2, T%p_FAST%nBeams + do j = 1, T%BD%Input(InputIndex, k)%DistrLoad%NNodes + T%BD%Input(InputIndex, k)%DistrLoad%Force(:, j) = matmul(T%BD%Input(InputIndex, 1)%DistrLoad%Force(:, j), AM%HubOrientation(:, :, k)) + T%BD%Input(InputIndex, k)%DistrLoad%Moment(:, j) = matmul(T%BD%Input(InputIndex, 1)%DistrLoad%Moment(:, j), AM%HubOrientation(:, :, k)) + end do + end do +end subroutine + +!> SS_ED_InputSolve_OtherBlades sets the blade-load ElastoDyn inputs from blade 1 to the other blades. +subroutine SS_ED_InputSolve_OtherBlades(AM, InputIndex, T) + type(Glue_AeroMap), intent(in) :: AM !< AeroMap data + integer(IntKi), intent(in) :: InputIndex !< Input index to transfer + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi) :: j, k + associate (BladePtLoads => T%ED%Input(InputIndex,iED)%BladePtLoads) + do k = 2, size(BladePtLoads, 1) + do j = 1, BladePtLoads(k)%NNodes + BladePtLoads(k)%Force(:, j) = matmul(BladePtLoads(1)%Force(:, j), AM%HubOrientation(:, :, k)) + BladePtLoads(k)%Moment(:, j) = matmul(BladePtLoads(1)%Moment(:, j), AM%HubOrientation(:, :, k)) + end do + end do + end associate +end subroutine + +!> SS_AD_InputSolve sets the blade-motion AeroDyn inputs for Blade 1. +subroutine SS_AD_InputSolve(AM, Mappings, InputIndex, T, ErrStat, ErrMsg) + type(Glue_AeroMap), intent(inout) :: AM !< AeroMap data + type(MappingType), intent(inout) :: Mappings(:) !< Module mapping + integer(IntKi), intent(in) :: InputIndex !< Input index to transfer + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(OUT) :: ErrStat !< Error status of the operation + character(*), intent(OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'SS_AD_InputSolve' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + ! Get blade motion inputs + call FAST_InputSolve(iModAero, AM%Mod%ModData, Mappings, InputIndex, T, ErrStat2, ErrMsg2, AM%Mod%VarMaps) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Set prescribed values for first blade + T%AD%Input(InputIndex)%rotors(1)%BladeMotion(1)%RotationVel = 0.0_ReKi + T%AD%Input(InputIndex)%rotors(1)%BladeMotion(1)%TranslationAcc = 0.0_ReKi + +end subroutine + +!> SS_AD_InputSolve_OtherBlades sets the blade-motion AeroDyn inputs. +subroutine SS_AD_InputSolve_OtherBlades(AM, InputIndex, T) + type(Glue_AeroMap), intent(in) :: AM !< AeroMap data + integer(IntKi), intent(in) :: InputIndex !< Input index to transfer + type(FAST_TurbineType), intent(INOUT) :: T !< Turbine type + integer(IntKi) :: j, k + associate (BladeMotion => T%AD%Input(InputIndex)%rotors(1)%BladeMotion) + do k = 2, size(BladeMotion, 1) + do j = 1, BladeMotion(k)%NNodes + BladeMotion(k)%TranslationDisp(:, j) = matmul(BladeMotion(1)%TranslationDisp(:, j), AM%HubOrientation(:, :, k)) + BladeMotion(k)%Orientation(:, :, j) = matmul(BladeMotion(1)%Orientation(:, :, j), AM%HubOrientation(:, :, k)) + BladeMotion(k)%TranslationVel(:, j) = matmul(BladeMotion(1)%TranslationVel(:, j), AM%HubOrientation(:, :, k)) + end do + end do + end associate +end subroutine + +subroutine SS_CalcContStateDeriv(AM, caseData, InputIndex, dxAry, T, ErrStat, ErrMsg) + type(Glue_AeroMap), intent(inout) :: AM !< AeroMap data + type(AeroMapCase), intent(in) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case + integer(IntKi), intent(in) :: InputIndex !< Index into input array + real(R8Ki), intent(inout) :: dxAry(:) !< continuous state derivative vector + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat !< Error status + character(*), intent(out) :: ErrMsg !< Error message + + character(*), parameter :: RoutineName = 'SS_CalcContStateDeriv' + integer(IntKi) :: ErrStat2 ! temporary Error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + integer(IntKi) :: i, k + integer(IntKi) :: BldMeshNode + real(R8Ki) :: Omega_Hub(3) + real(R8Ki) :: position(3) + real(R8Ki) :: omega_cross_position(3) + + ErrStat = ErrID_None + ErrMsg = "" + + ! Get the structural continuous state derivative + call FAST_GetOP(AM%Mod%ModData(iModStruct), SS_t_global, InputIndex, STATE_CURR, T, ErrStat2, ErrMsg2, & + dx_op=AM%Mod%ModData(iModStruct)%Lin%dx, dx_glue=dxAry) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Select based on which module is simulating the blades + select case (AM%Mod%ModData(iModStruct)%ID) + + case (Module_ED) ! ElastoDyn + + case (Module_BD) ! BeamDyn + + ! Set hub rotation speed + Omega_Hub = [real(caseData%RotSpeed, R8Ki), 0.0_R8Ki, 0.0_R8Ki] + + ! TODO: Make this work for BeamDyn + ! do K = 1, T%p_FAST%nBeams + + ! call BD_CalcContStateDeriv(SS_t_global, BD%Input(InputIndex, 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%m(k), BD%x(k, STATE_PRED), ErrStat2, ErrMsg2) + ! call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! ! subtract xdot(y) here: + ! ! note that this only works when the BldMotion mesh is on the FE nodes + ! do i = 2, BD%p(k)%node_total ! the first node isn't technically a state + ! BldMeshNode = BD%p(k)%NdIndx(i) + ! position = BD%y(k)%BldMotion%Position(:, BldMeshNode) + BD%y(k)%BldMotion%TranslationDisp(:, BldMeshNode) + ! omega_cross_position = cross_product(Omega_Hub, position) + + ! BD%x(k, STATE_PRED)%q(1:3, i) = BD%x(k, STATE_PRED)%q(1:3, i) - omega_cross_position + ! BD%x(k, STATE_PRED)%q(4:6, i) = BD%x(k, STATE_PRED)%q(4:6, i) - Omega_Hub + ! BD%x(k, STATE_PRED)%dqdt(1:3, i) = BD%x(k, STATE_PRED)%dqdt(1:3, i) - cross_product(Omega_Hub, omega_cross_position) + ! end do + + ! end do + + end select + +end subroutine + +subroutine SS_GetStates(AM, xAry, StateIndex, T, ErrStat, ErrMsg) + type(Glue_AeroMap), intent(inout) :: AM !< AeroMap data + real(R8Ki), intent(inout) :: xAry(:) !< Array of input packed values + integer(IntKi), intent(in) :: StateIndex !< State array index + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'SS_GetStates' + integer(IntKi) :: ErrStat2 ! temporary Error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + ! Loop through modules and get AeroMap states + do i = 1, size(AM%Mod%ModData) + associate (ModData => AM%Mod%ModData(i)) + call FAST_GetOP(ModData, SS_t_global, INPUT_CURR, StateIndex, T, ErrStat2, ErrMsg2, x_op=ModData%Lin%x, x_glue=xAry) + if (Failed()) return + end associate + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +!> SS_GetInputs packs the relevant parts of the modules' inputs for use in the steady-state solver. +subroutine SS_GetInputs(AM, uAry, InputIndex, T, ErrStat, ErrMsg) + type(Glue_AeroMap), intent(inout) :: AM !< AeroMap module + real(R8Ki), intent(inout) :: uAry(:) !< Array of input packed values + integer(IntKi), intent(in) :: InputIndex !< Input array index + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'SS_GetInputs' + integer(IntKi) :: ErrStat2 ! temporary Error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + integer(IntKi) :: i + + ! Loop through modules and get inputs + do i = 1, size(AM%Mod%ModData) + associate (ModData => AM%Mod%ModData(i)) + call FAST_GetOP(ModData, SS_t_global, InputIndex, STATE_CURR, T, ErrStat2, ErrMsg2, u_op=ModData%Lin%u, u_glue=uAry) + if (Failed()) return + end associate + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine SS_GetCalculatedInputs(AM, uAry, Mappings, T, ErrStat, ErrMsg) + type(Glue_AeroMap), intent(inout) :: AM !< AeroMap module + real(R8Ki), intent(inout) :: uAry(:) !< Inputs + type(MappingType), intent(inout) :: Mappings(:) !< Transfer mapping data + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat !< Error status + character(*), intent(out) :: ErrMsg !< Error message + + character(*), parameter :: RoutineName = 'SS_GetCalculatedInputs' + integer(IntKi) :: ErrStat2 ! temporary Error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + + ErrStat = ErrID_None + ErrMsg = "" + + ! Transfer motions to AeroDyn first + call SS_AD_InputSolve(AM, Mappings, INPUT_PREV, T, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Transfer loads to structural solver next + call FAST_InputSolve(iModStruct, AM%Mod%ModData, Mappings, INPUT_PREV, T, ErrStat2, ErrMsg2, AM%Mod%VarMaps) + if (Failed()) return + + ! Pack the transferred inputs into the vector + call SS_GetInputs(AM, uAry, INPUT_PREV, T, ErrStat2, ErrMsg2) + if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine SS_SetPrescribedInputs(caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD) + type(AeroMapCase), intent(in) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case + 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(AeroDyn_Data), intent(inout) :: AD !< AeroDyn data + + integer(IntKi) :: k + real(R8Ki) :: theta(3) + + ! Set prescribed inputs for all of the modules in the steady-state solve + + ED%Input(1,iED)%TwrAddedMass = 0.0_ReKi + ED%Input(1,iED)%PtfmAddedMass = 0.0_ReKi + + ED%Input(1,iED)%TowerPtLoads%Force = 0.0 + ED%Input(1,iED)%TowerPtLoads%Moment = 0.0 + ED%Input(1,iED)%NacelleLoads%Force = 0.0 + ED%Input(1,iED)%NacelleLoads%Moment = 0.0 + ED%Input(1,iED)%HubPtLoad%Force = 0.0 ! these are from BD, but they don't affect the ED calculations for aeromaps, so set them to 0 + ED%Input(1,iED)%HubPtLoad%Moment = 0.0 ! these are from BD, but they don't affect the ED calculations for aeromaps, so set them to 0 + + ED%Input(1,iED)%BlPitchCom = caseData%Pitch + ED%Input(1,iED)%YawMom = 0.0 + ED%Input(1,iED)%HSSBrTrqC = 0.0 + ED%Input(1,iED)%GenTrq = 0.0 + + ! BeamDyn + if (p_FAST%CompElast == Module_BD) then + + !CALL ED_CalcOutput( 0.0_DbKi, 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, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + do k = 1, p_FAST%nBeams + BD%Input(1, k)%RootMotion%TranslationDisp = 0.0_ReKi + + theta = EulerExtract(BD%Input(1, k)%RootMotion%RefOrientation(:, :, 1)) + theta(3) = -caseData%Pitch + BD%Input(1, k)%RootMotion%Orientation(:, :, 1) = EulerConstruct(theta) + + BD%Input(1, k)%RootMotion%RotationVel(1, 1) = caseData%RotSpeed !BD%Input(1,k)%RootMotion%RotationVel = ED%y_interp%BladeRootMotion(k)%RotationVel + BD%Input(1, k)%RootMotion%RotationVel(2:3, 1) = 0.0_ReKi + + BD%Input(1, k)%RootMotion%TranslationVel(:, 1) = cross_product(BD%Input(1, k)%RootMotion%RotationVel(:, 1), BD%Input(1, k)%RootMotion%Position(:, 1) - AD%Input(1)%rotors(1)%HubMotion%Position(:, 1)) ! ED%y_interp%BladeRootMotion(k)%TranslationVel + BD%Input(1, k)%RootMotion%TranslationAcc(:, 1) = cross_product(BD%Input(1, k)%RootMotion%RotationVel(:, 1), BD%Input(1, k)%RootMotion%TranslationVel(:, 1)) ! ED%y_interp%BladeRootMotion(k)%TranslationAcc + + BD%Input(1, k)%RootMotion%RotationAcc = 0.0_ReKi + end do ! k=p_FAST%nBeams + + end if ! BeamDyn + !BeamDyn's first "state" is not actually the state. So, do we need to do something with that????? + + !AeroDyn + !note: i'm skipping the (unused) TowerMotion mesh + AD%Input(1)%rotors(1)%HubMotion%TranslationDisp = 0.0 + AD%Input(1)%rotors(1)%HubMotion%Orientation = AD%Input(1)%rotors(1)%HubMotion%RefOrientation + AD%Input(1)%rotors(1)%HubMotion%RotationVel(1, :) = caseData%RotSpeed + AD%Input(1)%rotors(1)%HubMotion%RotationVel(2:3, :) = 0.0_ReKi + + do k = 1, size(AD%Input(1)%rotors(1)%BladeRootMotion, 1) + theta = EulerExtract(AD%Input(1)%rotors(1)%BladeRootMotion(k)%RefOrientation(:, :, 1)) + theta(3) = -caseData%Pitch + AD%Input(1)%rotors(1)%BladeRootMotion(k)%Orientation(:, :, 1) = EulerConstruct(theta) !AD%Input(1)%BladeRootMotion(k)%RefOrientation + + AD%Input(1)%rotors(1)%BladeMotion(k)%RotationVel = 0.0_ReKi + !AD%Input(1)%rotors(1)%BladeMotion(k)%RotationAcc = 0.0_ReKi + AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationAcc = 0.0_ReKi + end do + + ! Set FlowField information -- AD calculates everything from the data stored in the FlowField pointer + AD%p%FlowField%Uniform%VelH(:) = caseData%WindSpeed + AD%p%FlowField%Uniform%LinShrV(:) = 0.0_ReKi + AD%p%FlowField%Uniform%AngleH(:) = 0.0_ReKi + AD%p%FlowField%PropagationDir = 0.0_ReKi + + AD%Input(1)%rotors(1)%UserProp = 0.0_ReKi + +end subroutine + +end module diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 new file mode 100644 index 0000000000..a916b5321a --- /dev/null +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -0,0 +1,1938 @@ +!******************************************************************************* +! FAST_Funcs provides the glue code a uniform interface to module functions. +!............................................................................... +! LICENSING +! Copyright (C) 2024 National Renewable Energy Laboratory +! +! This file is part of FAST. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +!******************************************************************************* +!> This module contains functions for calling module subroutines +module FAST_Funcs + +use FAST_Types +use FAST_ModTypes +use NWTC_LAPACK +use AeroDisk +use AeroDyn +use BeamDyn +use ElastoDyn +use ExternalInflow +use ExtLoads +use ExtPtfm_MCKF +use FEAMooring +use HydroDyn +use IceDyn +use IceFloe +use InflowWind +use MAP +use MoorDyn +use OrcaFlexInterface +use SeaState +use SED +use ServoDyn +use SubDyn + +implicit none + +contains + +subroutine FAST_ExtrapInterp(ModData, t_global_next, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData !< Module data + real(DbKi), intent(in) :: t_global_next !< next global time step (t + dt), at which we're extrapolating inputs (and ED outputs) + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_ExtrapInterp' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j + + ErrStat = ErrID_None + ErrMsg = '' + + ! Select based on module ID + select case (ModData%ID) + + case (Module_AD) + if (ModData%Ins /= 1) return ! Perform extrap interp for first instance only, this advances all rotors + call AD_Input_ExtrapInterp(T%AD%Input(1:), T%AD%InputTimes, T%AD%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call AD_CopyInput(T%AD%Input(j), T%AD%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%AD%InputTimes) + + case (Module_ADsk) + call ADsk_Input_ExtrapInterp(T%ADsk%Input(1:), T%ADsk%InputTimes, T%ADsk%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call ADsk_CopyInput(T%ADsk%Input(j), T%ADsk%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%ADsk%InputTimes) + + case (Module_BD) + call BD_Input_ExtrapInterp(T%BD%Input(1:, ModData%Ins), T%BD%InputTimes(:, ModData%Ins), T%BD%Input(INPUT_TEMP, ModData%Ins), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call BD_CopyInput(T%BD%Input(j, ModData%Ins), T%BD%Input(j + 1, ModData%Ins), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%BD%InputTimes(:, ModData%Ins)) + + case (Module_ED) + call ED_Input_ExtrapInterp(T%ED%Input(1:, ModData%Ins), T%ED%InputTimes(:, ModData%Ins), T%ED%Input(INPUT_TEMP, ModData%Ins), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call ED_CopyInput(T%ED%Input(j, ModData%Ins), T%ED%Input(j + 1, ModData%Ins), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%ED%InputTimes(:, ModData%Ins)) + + case (Module_SED) + call SED_Input_ExtrapInterp(T%SED%Input(1:), T%SED%InputTimes, T%SED%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call SED_CopyInput(T%SED%Input(j), T%SED%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%SED%InputTimes) + + case (Module_ExtInfw) + ! Not used + + case (Module_ExtLd) + ! Not used + + case (Module_ExtPtfm) + call ExtPtfm_Input_ExtrapInterp(T%ExtPtfm%Input(1:), T%ExtPtfm%InputTimes, T%ExtPtfm%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call ExtPtfm_CopyInput(T%ExtPtfm%Input(j), T%ExtPtfm%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%ExtPtfm%InputTimes) + + case (Module_FEAM) + call FEAM_Input_ExtrapInterp(T%FEAM%Input(1:), T%FEAM%InputTimes, T%FEAM%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call FEAM_CopyInput(T%FEAM%Input(j), T%FEAM%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%FEAM%InputTimes) + + case (Module_HD) + call HydroDyn_Input_ExtrapInterp(T%HD%Input(1:), T%HD%InputTimes, T%HD%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call HydroDyn_CopyInput(T%HD%Input(j), T%HD%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%HD%InputTimes) + + case (Module_IceD) + call IceD_Input_ExtrapInterp(T%IceD%Input(1:, ModData%Ins), T%IceD%InputTimes(:, ModData%Ins), T%IceD%Input(INPUT_TEMP, ModData%Ins), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call IceD_CopyInput(T%IceD%Input(j, ModData%Ins), T%IceD%Input(j + 1, ModData%Ins), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%IceD%InputTimes(:, ModData%Ins)) + + case (Module_IceF) + call IceFloe_Input_ExtrapInterp(T%IceF%Input(1:), T%IceF%InputTimes, T%IceF%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call IceFloe_CopyInput(T%IceF%Input(j), T%IceF%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%IceF%InputTimes) + + case (Module_IfW) + call InflowWind_Input_ExtrapInterp(T%IfW%Input(1:), T%IfW%InputTimes, T%IfW%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call InflowWind_CopyInput(T%IfW%Input(j), T%IfW%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%IfW%InputTimes) + + case (Module_MAP) + call MAP_Input_ExtrapInterp(T%MAP%Input(1:), T%MAP%InputTimes, T%MAP%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call MAP_CopyInput(T%MAP%Input(j), T%MAP%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%MAP%InputTimes) + + case (Module_MD) + call MD_Input_ExtrapInterp(T%MD%Input(1:), T%MD%InputTimes, T%MD%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call MD_CopyInput(T%MD%Input(j), T%MD%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%MD%InputTimes) + + case (Module_Orca) + call Orca_Input_ExtrapInterp(T%Orca%Input(1:), T%Orca%InputTimes, T%Orca%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call Orca_CopyInput(T%Orca%Input(j), T%Orca%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%Orca%InputTimes) + + case (Module_SD) + call SD_Input_ExtrapInterp(T%SD%Input(1:), T%SD%InputTimes, T%SD%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call SD_CopyInput(T%SD%Input(j), T%SD%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%SD%InputTimes) + + case (Module_SeaSt) + ! call SeaSt_Input_ExtrapInterp(T%SeaSt%Input(1:), T%SeaSt%InputTimes, T%SeaSt%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + ! do j = T%p_FAST%InterpOrder, 1, -1 + ! call SeaSt_CopyInput(T%SeaSt%Input(j), T%SeaSt%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + ! T%SeaSt%InputTimes(j + 1) = T%SeaSt%InputTimes(j) + ! end do + ! call SeaSt_CopyInput(T%SeaSt%u, T%SeaSt%Input(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + ! T%SeaSt%InputTimes(1) = t_global_next + + case (Module_SrvD) + + call SrvD_Input_ExtrapInterp(T%SrvD%Input(1:), T%SrvD%InputTimes, T%SrvD%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call SrvD_CopyInput(T%SrvD%Input(j), T%SrvD%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%SrvD%InputTimes) + + case default + call SetErrStat(ErrID_Fatal, "Unknown module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select + +contains + subroutine ShiftInputTimes(InputTimes) + real(R8Ki) :: InputTimes(:) + integer(IntKi) :: k + do j = T%p_FAST%InterpOrder, 1, -1 + InputTimes(j + 1) = InputTimes(j) + end do + InputTimes(1) = t_global_next + end subroutine + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine FAST_InitInputStateArrays(ModAry, ThisTime, DT, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModAry(:) !< Module data + real(DbKi), intent(in) :: ThisTime !< Initial simulation time (almost always 0) + real(DbKi), intent(in) :: DT !< Glue code time step size + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_InitInputStateArrays' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + real(DbKi) :: t_global_next ! Simulation time for computing outputs + real(DbKi), allocatable :: InputTimes(:) ! Input times array + integer(IntKi) :: i, j, k + + ErrStat = ErrID_None + ErrMsg = '' + + ! Calculate input times array + InputTimes = ThisTime - DT*[(k, k=0, T%p_FAST%InterpOrder)] + + ! Loop through modules + do i = 1, size(ModAry) + associate (ModData => ModAry(i)) + + ! Copy state from current (1) to predicted (2), saved current (3), and saved predicted (4) + do k = 2, 4 + call FAST_CopyStates(ModData, T, STATE_CURR, k, MESH_NEWCOPY, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + ! Copy input from current to interpolation locations + do k = 2, T%p_FAST%InterpOrder + 1 + call FAST_CopyInput(ModData, T, INPUT_CURR, k, MESH_NEWCOPY, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + ! Copy input from current to temporary location + call FAST_CopyInput(ModData, T, INPUT_CURR, INPUT_TEMP, MESH_NEWCOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Select based on module ID + select case (ModData%ID) + case (Module_AD) + T%AD%InputTimes = InputTimes + case (Module_ADsk) + T%ADsk%InputTimes = InputTimes + case (Module_BD) + T%BD%InputTimes(:, ModData%Ins) = InputTimes + case (Module_ED) + T%ED%InputTimes(:, ModData%Ins) = InputTimes + case (Module_SED) + T%SED%InputTimes = InputTimes + case (Module_ExtPtfm) + T%ExtPtfm%InputTimes = InputTimes + case (Module_FEAM) + case (Module_HD) + T%HD%InputTimes = InputTimes + case (Module_IceD) + T%IceD%InputTimes(:, ModData%Ins) = InputTimes + case (Module_IceF) + T%IceF%InputTimes = InputTimes + case (Module_IfW) + T%IfW%InputTimes = InputTimes + case (Module_MAP) + T%MAP%InputTimes = InputTimes + case (Module_MD) + T%MD%InputTimes = InputTimes + case (Module_ExtInfw) + ! T%ExtInfw%InputTimes = InputTimes + case (Module_ExtLd) + ! T%ExtLd%InputTimes = InputTimes + case (Module_Orca) + T%Orca%InputTimes = InputTimes + case (Module_SD) + T%SD%InputTimes = InputTimes + case (Module_SeaSt) + T%SeaSt%InputTimes = InputTimes + case (Module_SrvD) + T%SrvD%InputTimes = InputTimes + case default + call SetErrStat(ErrID_Fatal, "Unknown module "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select + end associate + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData !< Module data + real(DbKi), intent(in) :: t_initial !< Initial simulation time (almost always 0) + integer(IntKi), intent(in) :: n_t_global !< Integer time step + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_UpdateStates' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j + integer(IntKi) :: j_ss ! substep loop counter + integer(IntKi) :: n_t_module ! simulation time step, loop counter for individual modules + real(DbKi) :: t_module ! Current simulation time for module + + ErrStat = ErrID_None + ErrMsg = '' + + ! Select based on module ID + select case (ModData%ID) + + case (Module_AD) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call AD_UpdateStates(t_module, n_t_module, T%AD%Input(1:), T%AD%InputTimes, & + T%AD%p, T%AD%x(STATE_PRED), T%AD%xd(STATE_PRED), & + T%AD%z(STATE_PRED), T%AD%OtherSt(STATE_PRED), & + T%AD%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + case (Module_ADsk) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call ADsk_UpdateStates(t_module, n_t_module, T%ADsk%Input(1:), T%ADsk%InputTimes, & + T%ADsk%p, T%ADsk%x(STATE_PRED), T%ADsk%xd(STATE_PRED), & + T%ADsk%z(STATE_PRED), T%ADsk%OtherSt(STATE_PRED), & + T%ADsk%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + case (Module_BD) + ! State update is handled by tight coupling solver + + case (Module_ED) + ! State update is handled by tight coupling solver + + case (Module_SED) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call SED_UpdateStates(t_module, n_t_module, T%SED%Input(1:), T%SED%InputTimes, & + T%SED%p, T%SED%x(STATE_PRED), T%SED%xd(STATE_PRED), & + T%SED%z(STATE_PRED), T%SED%OtherSt(STATE_PRED), & + T%SED%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + case (Module_ExtLd) + ! Not used + + case (Module_ExtPtfm) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call ExtPtfm_UpdateStates(t_module, n_t_module, T%ExtPtfm%Input(1:), T%ExtPtfm%InputTimes, & + T%ExtPtfm%p, T%ExtPtfm%x(STATE_PRED), T%ExtPtfm%xd(STATE_PRED), & + T%ExtPtfm%z(STATE_PRED), T%ExtPtfm%OtherSt(STATE_PRED), & + T%ExtPtfm%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + case (Module_FEAM) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call FEAM_UpdateStates(t_module, n_t_module, T%FEAM%Input(1:), T%FEAM%InputTimes, T%FEAM%p, & + T%FEAM%x(STATE_PRED), T%FEAM%xd(STATE_PRED), & + T%FEAM%z(STATE_PRED), T%FEAM%OtherSt(STATE_PRED), & + T%FEAM%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + case (Module_HD) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call HydroDyn_UpdateStates(t_module, n_t_module, T%HD%Input(1:), T%HD%InputTimes, T%HD%p, & + T%HD%x(STATE_PRED), T%HD%xd(STATE_PRED), & + T%HD%z(STATE_PRED), T%HD%OtherSt(STATE_PRED), & + T%HD%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + case (Module_IceD) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call IceD_UpdateStates(t_module, n_t_module, T%IceD%Input(1:, ModData%Ins), & + T%IceD%InputTimes(1:, ModData%Ins), T%IceD%p(ModData%Ins), & + T%IceD%x(ModData%Ins, STATE_PRED), T%IceD%xd(ModData%Ins, STATE_PRED), & + T%IceD%z(ModData%Ins, STATE_PRED), T%IceD%OtherSt(ModData%Ins, STATE_PRED), & + T%IceD%m(ModData%Ins), ErrStat2, ErrMsg2) + if (Failed()) return + end do + + case (Module_IceF) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call IceFloe_UpdateStates(t_module, n_t_module, T%IceF%Input(1:), T%IceF%InputTimes, T%IceF%p, & + T%IceF%x(STATE_PRED), T%IceF%xd(STATE_PRED), & + T%IceF%z(STATE_PRED), T%IceF%OtherSt(STATE_PRED), & + T%IceF%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + case (Module_IfW) + ! InflowWind does not have states + + case (Module_MAP) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call MAP_UpdateStates(t_module, n_t_module, T%MAP%Input(1:), T%MAP%InputTimes, T%MAP%p, & + T%MAP%x(STATE_PRED), T%MAP%xd(STATE_PRED), & + T%MAP%z(STATE_PRED), T%MAP%OtherSt, & + ErrStat2, ErrMsg2) + if (Failed()) return + end do + + case (Module_MD) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call MD_UpdateStates(t_module, n_t_module, T%MD%Input(1:), T%MD%InputTimes, T%MD%p, & + T%MD%x(STATE_PRED), T%MD%xd(STATE_PRED), & + T%MD%z(STATE_PRED), T%MD%OtherSt(STATE_PRED), & + T%MD%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do + +! case (Module_OpFM) + + case (Module_Orca) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call Orca_UpdateStates(t_module, n_t_module, T%Orca%Input(1:), T%Orca%InputTimes, T%Orca%p, & + T%Orca%x(STATE_PRED), T%Orca%xd(STATE_PRED), & + T%Orca%z(STATE_PRED), T%Orca%OtherSt(STATE_PRED), & + T%Orca%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + case (Module_SD) + ! State update is handled by tight coupling solver + + case (Module_SeaSt) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call SeaSt_UpdateStates(t_module, n_t_module, T%SeaSt%Input(1:), T%SeaSt%InputTimes, T%SeaSt%p, & + T%SeaSt%x(STATE_PRED), T%SeaSt%xd(STATE_PRED), & + T%SeaSt%z(STATE_PRED), T%SeaSt%OtherSt(STATE_PRED), & + T%SeaSt%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + case (Module_SrvD) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call SrvD_UpdateStates(t_module, n_t_module, T%SrvD%Input(1:), T%SrvD%InputTimes, T%SrvD%p, & + T%SrvD%x(STATE_PRED), T%SrvD%xd(STATE_PRED), & + T%SrvD%z(STATE_PRED), T%SrvD%OtherSt(STATE_PRED), & + T%SrvD%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + case default + call SetErrStat(ErrID_Fatal, "Unknown module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine FAST_CalcOutput(ModData, Mappings, ThisTime, iInput, iState, T, ErrStat, ErrMsg, CalcWriteOutput) + type(ModDataType), intent(in) :: ModData !< Module data + type(MappingType), intent(inout) :: Mappings(:) !< Output->Input mappings + real(DbKi), intent(in) :: ThisTime !< Time + integer(IntKi), intent(in) :: iInput !< Input index + integer(IntKi), intent(in) :: iState !< State index + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + logical, optional, intent(in) :: CalcWriteOutput !< Flag to calculate data for write output + + character(*), parameter :: RoutineName = 'FAST_CalcOutput' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + logical :: CalcWriteOutputLoc + + ErrStat = ErrID_None + ErrMsg = '' + + if (present(CalcWriteOutput)) then + CalcWriteOutputLoc = CalcWriteOutput + else + CalcWriteOutputLoc = .true. + end if + + ! Select based on module ID + select case (ModData%ID) + + case (Module_AD) + ! Call CalcOutput on first instance, calculation is for all rotors + if (ModData%Ins == 1) then + call AD_CalcOutput(ThisTime, T%AD%Input(iInput), T%AD%p, & + T%AD%x(iState), T%AD%xd(iState), T%AD%z(iState), T%AD%OtherSt(iState), & + T%AD%y, T%AD%m, ErrStat2, ErrMsg2, CalcWriteOutput) + end if + + case (Module_ADsK) + call ADsK_CalcOutput(ThisTime, T%ADsK%Input(iInput), T%ADsK%p, & + T%ADsK%x(iState), T%ADsK%xd(iState), T%ADsK%z(iState), T%ADsK%OtherSt(iState), & + T%ADsK%y, T%ADsK%m, ErrStat2, ErrMsg2, CalcWriteOutput) + + case (Module_BD) + call BD_CalcOutput(ThisTime, T%BD%Input(iInput, ModData%Ins), T%BD%p(ModData%Ins), & + T%BD%x(ModData%Ins, iState), T%BD%xd(ModData%Ins, iState), & + T%BD%z(ModData%Ins, iState), T%BD%OtherSt(ModData%Ins, iState), & + T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, CalcWriteOutput) + + case (Module_ED) + call ED_CalcOutput(ThisTime, T%ED%Input(iInput, ModData%Ins), T%ED%p(ModData%Ins), & + T%ED%x(ModData%Ins, iState), T%ED%xd(ModData%Ins, iState), & + T%ED%z(ModData%Ins, iState), T%ED%OtherSt(ModData%Ins, iState), & + T%ED%y(ModData%Ins), T%ED%m(ModData%Ins), ErrStat2, ErrMsg2) + + case (Module_SED) + call SED_CalcOutput(ThisTime, T%SED%Input(iInput), T%SED%p, & + T%SED%x(iState), T%SED%xd(iState), T%SED%z(iState), T%SED%OtherSt(iState), & + T%SED%y, T%SED%m, ErrStat2, ErrMsg2) + + case (Module_ExtInfw) + ! Not used + + case (Module_ExtLd) + call ExtLd_CalcOutput(ThisTime, T%ExtLd%u, T%ExtLd%p, & + T%ExtLd%x(iState), T%ExtLd%xd(iState), T%ExtLd%z(iState), T%ExtLd%OtherSt(iState), & + T%ExtLd%y, T%ExtLd%m, ErrStat2, ErrMsg2) + + case (Module_ExtPtfm) + call ExtPtfm_CalcOutput(ThisTime, T%ExtPtfm%Input(iInput), T%ExtPtfm%p, & + T%ExtPtfm%x(iState), T%ExtPtfm%xd(iState), T%ExtPtfm%z(iState), T%ExtPtfm%OtherSt(iState), & + T%ExtPtfm%y, T%ExtPtfm%m, ErrStat2, ErrMsg2) + + case (Module_FEAM) + call FEAM_CalcOutput(ThisTime, T%FEAM%Input(iInput), T%FEAM%p, & + T%FEAM%x(iState), T%FEAM%xd(iState), T%FEAM%z(iState), T%FEAM%OtherSt(iState), & + T%FEAM%y, T%FEAM%m, ErrStat2, ErrMsg2) + + case (Module_HD) + call HydroDyn_CalcOutput(ThisTime, T%HD%Input(iInput), T%HD%p, & + T%HD%x(iState), T%HD%xd(iState), T%HD%z(iState), T%HD%OtherSt(iState), & + T%HD%y, T%HD%m, ErrStat2, ErrMsg2) + + case (Module_IceD) + call IceD_CalcOutput(ThisTime, T%IceD%Input(iInput, ModData%Ins), T%IceD%p(ModData%Ins), & + T%IceD%x(ModData%Ins, iState), T%IceD%xd(ModData%Ins, iState), & + T%IceD%z(ModData%Ins, iState), T%IceD%OtherSt(ModData%Ins, iState), & + T%IceD%y(ModData%Ins), T%IceD%m(ModData%Ins), ErrStat2, ErrMsg2) + + case (Module_IceF) + call IceFloe_CalcOutput(ThisTime, T%IceF%Input(iInput), T%IceF%p, & + T%IceF%x(iState), T%IceF%xd(iState), T%IceF%z(iState), T%IceF%OtherSt(iState), & + T%IceF%y, T%IceF%m, ErrStat2, ErrMsg2) + + case (Module_IfW) + call InflowWind_CalcOutput(ThisTime, T%IfW%Input(iInput), T%IfW%p, & + T%IfW%x(iState), T%IfW%xd(iState), T%IfW%z(iState), T%IfW%OtherSt(iState), & + T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2) + + case (Module_MAP) + call MAP_CalcOutput(ThisTime, T%MAP%Input(iInput), T%MAP%p, & + T%MAP%x(iState), T%MAP%xd(iState), T%MAP%z(iState), T%MAP%OtherSt, & + T%MAP%y, ErrStat2, ErrMsg2) + + case (Module_MD) + call MD_CalcOutput(ThisTime, T%MD%Input(iInput), T%MD%p, & + T%MD%x(iState), T%MD%xd(iState), T%MD%z(iState), T%MD%OtherSt(iState), & + T%MD%y, T%MD%m, ErrStat2, ErrMsg2) + + case (Module_Orca) + call Orca_CalcOutput(ThisTime, T%Orca%Input(iInput), T%Orca%p, & + T%Orca%x(iState), T%Orca%xd(iState), T%Orca%z(iState), T%Orca%OtherSt(iState), & + T%Orca%y, T%Orca%m, ErrStat2, ErrMsg2) + + case (Module_SD) + call SD_CalcOutput(ThisTime, T%SD%Input(iInput), T%SD%p, & + T%SD%x(iState), T%SD%xd(iState), T%SD%z(iState), T%SD%OtherSt(iState), & + T%SD%y, T%SD%m, ErrStat2, ErrMsg2) + + case (Module_SeaSt) + call SeaSt_CalcOutput(ThisTime, T%SeaSt%Input(iInput), T%SeaSt%p, & + T%SeaSt%x(iState), T%SeaSt%xd(iState), T%SeaSt%z(iState), T%SeaSt%OtherSt(iState), & + T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2) + + case (Module_SrvD) + call SrvD_CalcOutput(ThisTime, T%SrvD%Input(iInput), T%SrvD%p, & + T%SrvD%x(iState), T%SrvD%xd(iState), T%SrvD%z(iState), T%SrvD%OtherSt(iState), & + T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2) + + case default + call SetErrStat(ErrID_Fatal, "Unknown module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select + + ! Check for errors during calc output call + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + ! Set ready flag in mappings where this module is the source + do i = 1, size(Mappings) + if (Mappings(i)%iModSrc == ModData%iMod) Mappings(i)%Ready = .true. + end do + +end subroutine + +subroutine FAST_GetOP(ModData, ThisTime, iInput, iState, T, ErrStat, ErrMsg, & + u_op, y_op, x_op, dx_op, z_op, u_glue, y_glue, x_glue, dx_glue, z_glue) + use AeroDyn, only: AD_CalcWind_Rotor + type(ModDataType), intent(in) :: ModData !< Module information + real(DbKi), intent(in) :: ThisTime !< Time + integer(IntKi), intent(in) :: iInput !< Input index + integer(IntKi), intent(in) :: iState !< State index + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + real(R8Ki), allocatable, optional, intent(inout) :: u_op(:) !< values of linearized inputs + real(R8Ki), allocatable, optional, intent(inout) :: y_op(:) !< values of linearized outputs + real(R8Ki), allocatable, optional, intent(inout) :: x_op(:) !< values of linearized continuous states + real(R8Ki), allocatable, optional, intent(inout) :: dx_op(:) !< values of first time derivatives of linearized continuous states + real(R8Ki), allocatable, optional, intent(inout) :: z_op(:) !< values of linearized constraint states + real(R8Ki), optional, intent(inout) :: u_glue(:) + real(R8Ki), optional, intent(inout) :: y_glue(:) + real(R8Ki), optional, intent(inout) :: x_glue(:) + real(R8Ki), optional, intent(inout) :: dx_glue(:) + real(R8Ki), optional, intent(inout) :: z_glue(:) + + character(*), parameter :: RoutineName = 'FAST_GetOP' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + ! If inputs are requested + if (present(u_op) .and. (ModData%Vars%Nu > 0)) then + + if (.not. allocated(u_op)) then + call AllocAry(u_op, ModData%Vars%Nu, "u_op", ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! Select based on module ID + select case (ModData%ID) + case (Module_AD) + call AD_VarsPackInput(ModData%Vars, T%AD%Input(iInput)%rotors(ModData%Ins), u_op) + call AD_VarsPackExtInput(ModData%Vars, ThisTime, T%AD%p, u_op) + case (Module_ADsk) + call ADsk_VarsPackInput(ModData%Vars, T%ADsk%Input(iInput), u_op) + case (Module_BD) + call BD_VarsPackInput(ModData%Vars, T%BD%Input(iInput, ModData%Ins), u_op) + case (Module_ED) + call ED_VarsPackInput(ModData%Vars, T%ED%Input(iInput, ModData%Ins), u_op) + call ED_PackExtInputAry(ModData%Vars, T%ED%Input(iInput, ModData%Ins), u_op, ErrStat2, ErrMsg2); if (Failed()) return + case (Module_SED) + call SED_VarsPackInput(ModData%Vars, T%SED%Input(iInput), u_op) + case (Module_ExtPtfm) + call ExtPtfm_VarsPackInput(ModData%Vars, T%ExtPtfm%Input(iInput), u_op) + case (Module_FEAM) + call FEAM_VarsPackInput(ModData%Vars, T%FEAM%Input(iInput), u_op) + case (Module_HD) + call HydroDyn_VarsPackInput(ModData%Vars, T%HD%Input(iInput), u_op) + call HD_PackExtInputAry(ModData%Vars, T%HD%Input(iInput), u_op) + case (Module_IceD) + call IceD_VarsPackInput(ModData%Vars, T%IceD%Input(iInput, ModData%Ins), u_op) + case (Module_IceF) + call IceFloe_VarsPackInput(ModData%Vars, T%IceF%Input(iInput), u_op) + case (Module_IfW) + call InflowWind_VarsPackInput(ModData%Vars, T%IfW%Input(iInput), u_op) + call InflowWind_PackExtInputAry(ModData%Vars, ThisTime, T%IfW%p, u_op) + case (Module_MAP) + call MAP_VarsPackInput(ModData%Vars, T%MAP%Input(iInput), u_op) + case (Module_MD) + call MD_VarsPackInput(ModData%Vars, T%MD%Input(iInput), u_op) + case (Module_ExtInfw) + ! call ExtInfw_VarsPackInput(ModData%Vars, T%ExtInfw%Input(iIndex), u_op) + case (Module_Orca) + call Orca_VarsPackInput(ModData%Vars, T%Orca%Input(iInput), u_op) + case (Module_SD) + call SD_VarsPackInput(ModData%Vars, T%SD%Input(iInput), u_op) + case (Module_SeaSt) + call SeaSt_VarsPackInput(ModData%Vars, T%SeaSt%Input(iInput), u_op) + call SeaSt_PackExtInputAry(ModData%Vars, T%SeaSt%Input(iInput), u_op) + case (Module_SrvD) + call SrvD_VarsPackInput(ModData%Vars, T%SrvD%Input(iInput), u_op) + case default + call SetErrStat(ErrID_Fatal, "Input unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select + + ! If glue array is present, transfer from module to glue + if (present(u_glue)) call XfrLocToGluAry(ModData%Vars%u, u_op, u_glue) + end if + + ! If outputs are requested + if (present(y_op) .and. (ModData%Vars%Ny > 0)) then + + if (.not. allocated(y_op)) then + call AllocAry(y_op, ModData%Vars%Ny, "y_op", ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! Select based on module ID + select case (ModData%ID) + case (Module_AD) + call AD_VarsPackOutput(ModData%Vars, T%AD%y%rotors(ModData%Ins), y_op) + case (Module_ADsk) + call ADsk_VarsPackOutput(ModData%Vars, T%ADsk%y, y_op) + case (Module_BD) + call BD_VarsPackOutput(ModData%Vars, T%BD%y(ModData%Ins), y_op) + case (Module_ED) + call ED_VarsPackOutput(ModData%Vars, T%ED%y(ModData%Ins), y_op) + case (Module_SED) + call SED_VarsPackOutput(ModData%Vars, T%SED%y, y_op) + case (Module_ExtPtfm) + call ExtPtfm_VarsPackOutput(ModData%Vars, T%ExtPtfm%y, y_op) + case (Module_FEAM) + call FEAM_VarsPackOutput(ModData%Vars, T%FEAM%y, y_op) + case (Module_HD) + call HydroDyn_VarsPackOutput(ModData%Vars, T%HD%y, y_op) + case (Module_IceD) + call IceD_VarsPackOutput(ModData%Vars, T%IceD%y(ModData%Ins), y_op) + case (Module_IceF) + call IceFloe_VarsPackOutput(ModData%Vars, T%IceF%y, y_op) + case (Module_IfW) + call InflowWind_VarsPackOutput(ModData%Vars, T%IfW%y, y_op) + call InflowWind_PackExtOutputAry(ModData%Vars, ThisTime, T%IfW%p, y_op) + case (Module_MAP) + call MAP_VarsPackOutput(ModData%Vars, T%MAP%y, y_op) + case (Module_MD) + call MD_VarsPackOutput(ModData%Vars, T%MD%y, y_op) + case (Module_ExtInfw) + call ExtInfw_VarsPackOutput(ModData%Vars, T%ExtInfw%y, y_op) + case (Module_Orca) + call Orca_VarsPackOutput(ModData%Vars, T%Orca%y, y_op) + case (Module_SD) + call SD_VarsPackOutput(ModData%Vars, T%SD%y, y_op) + case (Module_SeaSt) + call SeaSt_PackExtOutputAry(ModData%Vars, T%SeaSt%y, y_op) + call SeaSt_VarsPackOutput(ModData%Vars, T%SeaSt%y, y_op) + case (Module_SrvD) + call SrvD_VarsPackOutput(ModData%Vars, T%SrvD%y, y_op) + case default + call SetErrStat(ErrID_Fatal, "Output unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select + + ! If glue array is present, transfer from module to glue + if (present(y_glue)) call XfrLocToGluAry(ModData%Vars%y, y_op, y_glue) + end if + + ! If continuous states are requested + if (present(x_op) .and. (ModData%Vars%Nx > 0)) then + + if (.not. allocated(x_op)) then + call AllocAry(x_op, ModData%Vars%Nx, "x_op", ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! Select based on module ID + select case (ModData%ID) + case (Module_AD) + call AD_VarsPackContState(ModData%Vars, T%AD%x(iState)%rotors(ModData%Ins), x_op) + case (Module_ADsk) + call ADsk_VarsPackContState(ModData%Vars, T%ADsk%x(iState), x_op) + case (Module_BD) + call BD_VarsPackContState(ModData%Vars, T%BD%x(ModData%Ins, iState), x_op) + case (Module_ED) + call ED_VarsPackContState(ModData%Vars, T%ED%x(ModData%Ins, iState), x_op) + case (Module_SED) + call SED_VarsPackContState(ModData%Vars, T%SED%x(iState), x_op) + case (Module_ExtPtfm) + call ExtPtfm_VarsPackContState(ModData%Vars, T%ExtPtfm%x(iState), x_op) + case (Module_FEAM) + call FEAM_VarsPackContState(ModData%Vars, T%FEAM%x(iState), x_op) + case (Module_HD) + call HydroDyn_VarsPackContState(ModData%Vars, T%HD%x(iState), x_op) + case (Module_IceD) + call IceD_VarsPackContState(ModData%Vars, T%IceD%x(ModData%Ins, iState), x_op) + case (Module_IceF) + call IceFloe_VarsPackContState(ModData%Vars, T%IceF%x(iState), x_op) + case (Module_IfW) + call InflowWind_VarsPackContState(ModData%Vars, T%IfW%x(iState), x_op) + case (Module_MAP) + call MAP_VarsPackContState(ModData%Vars, T%MAP%x(iState), x_op) + case (Module_MD) + call MD_VarsPackContState(ModData%Vars, T%MD%x(iState), x_op) + case (Module_ExtInfw) + ! call ExtInfw_VarsPackContState(ModData%Vars, T%ExtInfw%x(StateIndex), x_op) + case (Module_Orca) + call Orca_VarsPackContState(ModData%Vars, T%Orca%x(iState), x_op) + case (Module_SD) + call SD_VarsPackContState(ModData%Vars, T%SD%x(iState), x_op) + case (Module_SeaSt) + call SeaSt_VarsPackContState(ModData%Vars, T%SeaSt%x(iState), x_op) + case (Module_SrvD) + call SrvD_VarsPackContState(ModData%Vars, T%SrvD%x(iState), x_op) + case default + call SetErrStat(ErrID_Fatal, "Continuous State unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select + + ! If glue array is present, transfer from module to glue + if (present(x_glue)) call XfrLocToGluAry(ModData%Vars%x, x_op, x_glue) + end if + + ! If continuous state derivatives are requested + if (present(dx_op) .and. (ModData%Vars%Nx > 0)) then + + if (.not. allocated(dx_op)) then + call AllocAry(dx_op, ModData%Vars%Nx, "dx_op", ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! Select based on module ID + select case (ModData%ID) + case (Module_AD) + i = 1 + call AD_CalcWind_Rotor(ThisTime, T%AD%Input(iInput)%rotors(ModData%Ins), & + T%AD%p%FlowField, T%AD%p%rotors(ModData%Ins), T%AD%p, & + T%AD%m, T%AD%m%Inflow(iInput)%RotInflow(ModData%Ins), & + i, ErrStat2, ErrMsg2) + if (Failed()) return + call RotCalcContStateDeriv(ThisTime, T%AD%Input(iInput)%rotors(ModData%Ins), & + T%AD%m%Inflow(iInput)%RotInflow(ModData%Ins), & + T%AD%p%rotors(ModData%Ins), T%AD%p, & + T%AD%x(iState)%rotors(ModData%Ins), & + T%AD%xd(iState)%rotors(ModData%Ins), & + T%AD%z(iState)%rotors(ModData%Ins), & + T%AD%OtherSt(iState)%rotors(ModData%Ins), & + T%AD%m%rotors(ModData%Ins), & + T%AD%m%rotors(ModData%Ins)%dxdt_lin, & + ErrStat2, ErrMsg2) + if (Failed()) return + call AD_VarsPackContStateDeriv(ModData%Vars, T%AD%m%rotors(ModData%Ins)%dxdt_lin, dx_op) + + case (Module_ADsk) + call ADsk_CalcContStateDeriv(ThisTime, T%ADsk%Input(iInput), T%ADsk%p, T%ADsk%x(iState), & + T%ADsk%xd(iState), T%ADsk%z(iState), T%ADsk%OtherSt(iState), & + T%ADsk%m, T%ADsk%m%dxdt_lin, ErrStat2, ErrMsg2) + if (Failed()) return + call ADsk_VarsPackContStateDeriv(ModData%Vars, T%ADsk%m%dxdt_lin, dx_op) + + case (Module_BD) + call BD_CalcContStateDeriv(ThisTime, T%BD%Input(iInput, ModData%Ins), & + T%BD%p(ModData%Ins), & + T%BD%x(ModData%Ins, iState), & + T%BD%xd(ModData%Ins, iState), & + T%BD%z(ModData%Ins, iState), & + T%BD%OtherSt(ModData%Ins, iState), & + T%BD%m(ModData%Ins), & + T%BD%m(ModData%Ins)%dxdt_lin, & + ErrStat2, ErrMsg2) + if (Failed()) return + call BD_VarsPackContStateDeriv(ModData%Vars, T%BD%m(ModData%Ins)%dxdt_lin, dx_op) + + case (Module_ED) + call ED_CalcContStateDeriv(ThisTime, T%ED%Input(iInput, ModData%Ins), & + T%ED%p(ModData%Ins), & + T%ED%x(ModData%Ins, iState), & + T%ED%xd(ModData%Ins, iState), & + T%ED%z(ModData%Ins, iState), & + T%ED%OtherSt(ModData%Ins, iState), & + T%ED%m(ModData%Ins), & + T%ED%m(ModData%Ins)%dxdt_lin, & + ErrStat2, ErrMsg2) + if (Failed()) return + call ED_VarsPackContStateDeriv(ModData%Vars, T%ED%m(ModData%Ins)%dxdt_lin, dx_op) + + case (Module_SED) + call SED_CalcContStateDeriv(ThisTime, T%SED%Input(iInput), T%SED%p, T%SED%x(iState), & + T%SED%xd(iState), T%SED%z(iState), T%SED%OtherSt(iState), & + T%SED%m, T%SED%m%dxdt_lin, ErrStat2, ErrMsg2) + if (Failed()) return + call SED_VarsPackContStateDeriv(ModData%Vars, T%SED%m%dxdt_lin, dx_op) + + case (Module_ExtPtfm) + call ExtPtfm_CalcContStateDeriv(ThisTime, T%ExtPtfm%Input(iInput), & + T%ExtPtfm%p, T%ExtPtfm%x(iState), & + T%ExtPtfm%xd(iState), T%ExtPtfm%z(iState), & + T%ExtPtfm%OtherSt(iState), & + T%ExtPtfm%m, T%ExtPtfm%m%dxdt_lin, & + ErrStat2, ErrMsg2); if (Failed()) return + call ExtPtfm_VarsPackContStateDeriv(ModData%Vars, T%ExtPtfm%m%dxdt_lin, dx_op) + +! case (Module_FEAM) +! call FEAM_VarsPackContStateDeriv(ModData%Vars, T%FEAM%x(StateIndex), dx_op) + + case (Module_HD) + call HydroDyn_CalcContStateDeriv(ThisTime, T%HD%Input(iInput), T%HD%p, T%HD%x(iState), & + T%HD%xd(iState), T%HD%z(iState), T%HD%OtherSt(iState), & + T%HD%m, T%HD%m%dxdt_lin, ErrStat2, ErrMsg2) + if (Failed()) return + call HydroDyn_VarsPackContStateDeriv(ModData%Vars, T%HD%m%dxdt_lin, dx_op) + +! case (Module_IceD) +! call IceD_CalcContStateDeriv(ThisTime, T%IceD%Input(InputIndex), T%IceD%p, T%IceD%x(StateIndex), & +! T%IceD%xd(StateIndex), T%IceD%z(StateIndex), T%IceD%OtherSt(StateIndex), & +! T%IceD%m, T%IceD%m%dxdt_lin, ErrStat2, ErrMsg2) +! if (Failed()) return +! call IceD_VarsPackContStateDeriv(ModData%Vars, T%IceD%m%dxdt_lin, dx_op) + +! case (Module_IceF) +! call IceFloe_VarsPackContStateDeriv(ModData%Vars, T%IceF%x(StateIndex), dx_op) + +! case (Module_IfW) +! call InflowWind_VarsPackContStateDeriv(ModData%Vars, T%IfW%x(StateIndex), dx_op) + +! case (Module_MAP) +! call MAP_VarsPackContStateDeriv(ModData%Vars, T%MAP%x(StateIndex), dx_op) + + case (Module_MD) + call MD_CalcContStateDeriv(ThisTime, T%MD%Input(iInput), T%MD%p, T%MD%x(iState), & + T%MD%xd(iState), T%MD%z(iState), T%MD%OtherSt(iState), & + T%MD%m, T%MD%m%dxdt_lin, ErrStat2, ErrMsg2) + if (Failed()) return + call MD_VarsPackContStateDeriv(ModData%Vars, T%MD%m%dxdt_lin, dx_op) + +! case (Module_ExtInfw) +! call ExtInfw_VarsPackContStateDeriv(ModData%Vars, T%ExtInfw%x(StateIndex), dx_op) + +! case (Module_Orca) +! call Orca_VarsPackContStateDeriv(ModData%Vars, T%Orca%x(StateIndex), dx_op) + + case (Module_SD) + call SD_CalcContStateDeriv(ThisTime, T%SD%Input(iInput), T%SD%p, T%SD%x(iState), & + T%SD%xd(iState), T%SD%z(iState), T%SD%OtherSt(iState), & + T%SD%m, T%SD%m%dxdt_lin, ErrStat2, ErrMsg2) + if (Failed()) return + call SD_VarsPackContStateDeriv(ModData%Vars, T%SD%m%dxdt_lin, dx_op) + +! case (Module_SeaSt) +! call SeaSt_VarsPackContStateDeriv(ModData%Vars, T%SeaSt%x(StateIndex), dx_op) + + case (Module_SrvD) + call SrvD_CalcContStateDeriv(ThisTime, T%SrvD%Input(iInput), T%SrvD%p, T%SrvD%x(iState), & + T%SrvD%xd(iState), T%SrvD%z(iState), T%SrvD%OtherSt(iState), & + T%SrvD%m, T%SrvD%m%dxdt_lin, ErrStat2, ErrMsg2) + call SrvD_VarsPackContStateDeriv(ModData%Vars, T%SrvD%m%dxdt_lin, dx_op) + + case default + call SetErrStat(ErrID_Fatal, "Continuous State Derivatives unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select + + ! If glue array is present, transfer from module to glue + if (present(dx_glue)) call XfrLocToGluAry(ModData%Vars%x, dx_op, dx_glue) + end if + + ! If constraint states are requested + if (present(z_op)) then + + if (.not. allocated(z_op)) then + call AllocAry(z_op, ModData%Vars%Nz, "z_op", ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! Select based on module ID + select case (ModData%ID) + case (Module_AD) + call AD_VarsPackConstrState(ModData%Vars, T%AD%z(iState)%rotors(ModData%Ins), z_op) + case (Module_ADsk) + call ADsk_VarsPackConstrState(ModData%Vars, T%ADsk%z(iState), z_op) + case (Module_BD) + call BD_VarsPackConstrState(ModData%Vars, T%BD%z(ModData%Ins, iState), z_op) + case (Module_ED) + call ED_VarsPackConstrState(ModData%Vars, T%ED%z(ModData%Ins, iState), z_op) + case (Module_SED) + call SED_VarsPackConstrState(ModData%Vars, T%SED%z(iState), z_op) + case (Module_ExtPtfm) + call ExtPtfm_VarsPackConstrState(ModData%Vars, T%ExtPtfm%z(iState), z_op) + case (Module_FEAM) + call FEAM_VarsPackConstrState(ModData%Vars, T%FEAM%z(iState), z_op) + case (Module_HD) + call HydroDyn_VarsPackConstrState(ModData%Vars, T%HD%z(iState), z_op) + case (Module_IceD) + call IceD_VarsPackConstrState(ModData%Vars, T%IceD%z(ModData%Ins, iState), z_op) + case (Module_IceF) + call IceFloe_VarsPackConstrState(ModData%Vars, T%IceF%z(iState), z_op) + case (Module_IfW) + call InflowWind_VarsPackConstrState(ModData%Vars, T%IfW%z(iState), z_op) + case (Module_MAP) + call MAP_VarsPackConstrState(ModData%Vars, T%MAP%z(iState), z_op) + case (Module_MD) + call MD_VarsPackConstrState(ModData%Vars, T%MD%z(iState), z_op) + case (Module_ExtInfw) + ! call ExtInfw_VarsPackConstrState(ModData%Vars, T%ExtInfw%z(StateIndex), z_op) + case (Module_Orca) + call Orca_VarsPackConstrState(ModData%Vars, T%Orca%z(iState), z_op) + case (Module_SD) + call SD_VarsPackConstrState(ModData%Vars, T%SD%z(iState), z_op) + case (Module_SeaSt) + call SeaSt_VarsPackConstrState(ModData%Vars, T%SeaSt%z(iState), z_op) + case (Module_SrvD) + call SrvD_VarsPackConstrState(ModData%Vars, T%SrvD%z(iState), z_op) + case default + call SetErrStat(ErrID_Fatal, "Constraint State unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select + + ! If glue array is present, transfer from module to glue + if (present(z_glue)) call XfrLocToGluAry(ModData%Vars%z, z_op, z_glue) + end if + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine FAST_SetOP(ModData, iInput, iState, T, ErrStat, ErrMsg, & + u_op, x_op, z_op, u_glue, x_glue, z_glue) + type(ModDataType), intent(in) :: ModData !< Module information + integer(IntKi), intent(in) :: iInput !< Input index + integer(IntKi), intent(in) :: iState !< State index + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + real(R8Ki), allocatable, optional, intent(inout) :: u_op(:), u_glue(:) !< values of linearized inputs + real(R8Ki), allocatable, optional, intent(inout) :: x_op(:), x_glue(:) !< values of linearized continuous states + real(R8Ki), allocatable, optional, intent(inout) :: z_op(:), z_glue(:) !< values of linearized constraint states + + character(*), parameter :: RoutineName = 'FAST_SetOP' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + ! If inputs are requested + if (present(u_op)) then + + ! If glue array is present, transfer from module to glue + if (present(u_glue)) call XfrGluToModAry(ModData%Vars%u, u_glue, u_op) + + ! Select based on module ID + select case (ModData%ID) + case (Module_AD) + call AD_VarsUnpackInput(ModData%Vars, u_op, T%AD%Input(iInput)%rotors(ModData%Ins)) + case (Module_ADsk) + call ADsk_VarsUnpackInput(ModData%Vars, u_op, T%ADsk%Input(iInput)) + case (Module_BD) + call BD_VarsUnpackInput(ModData%Vars, u_op, T%BD%Input(iInput, ModData%Ins)) + case (Module_ED) + call ED_VarsUnpackInput(ModData%Vars, u_op, T%ED%Input(iInput, ModData%Ins)) + case (Module_SED) + call SED_VarsUnpackInput(ModData%Vars, u_op, T%SED%Input(iInput)) + case (Module_ExtPtfm) + call ExtPtfm_VarsUnpackInput(ModData%Vars, u_op, T%ExtPtfm%Input(iInput)) + case (Module_FEAM) + call FEAM_VarsUnpackInput(ModData%Vars, u_op, T%FEAM%Input(iInput)) + case (Module_HD) + call HydroDyn_VarsUnpackInput(ModData%Vars, u_op, T%HD%Input(iInput)) + case (Module_IceD) + call IceD_VarsUnpackInput(ModData%Vars, u_op, T%IceD%Input(iInput, ModData%Ins)) + case (Module_IceF) + call IceFloe_VarsUnpackInput(ModData%Vars, u_op, T%IceF%Input(iInput)) + case (Module_IfW) + call InflowWind_VarsUnpackInput(ModData%Vars, u_op, T%IfW%Input(iInput)) + case (Module_MAP) + call MAP_VarsUnpackInput(ModData%Vars, u_op, T%MAP%Input(iInput)) + case (Module_MD) + call MD_VarsUnpackInput(ModData%Vars, u_op, T%MD%Input(iInput)) + case (Module_ExtInfw) + ! call ExtInfw_VarsUnpackInput(ModData%Vu_op, ars, T%ExtInfw%Input(InputIndex)) + case (Module_Orca) + call Orca_VarsUnpackInput(ModData%Vars, u_op, T%Orca%Input(iInput)) + case (Module_SD) + call SD_VarsUnpackInput(ModData%Vars, u_op, T%SD%Input(iInput)) + case (Module_SeaSt) + call SeaSt_VarsUnpackInput(ModData%Vars, u_op, T%SeaSt%Input(iInput)) + case (Module_SrvD) + call SrvD_VarsUnpackInput(ModData%Vars, u_op, T%SrvD%Input(iInput)) + case default + call SetErrStat(ErrID_Fatal, "Input unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select + + end if + + ! If continuous states are requested + if (present(x_op)) then + + ! If glue array is present, transfer from module to glue + if (present(x_glue)) call XfrGluToModAry(ModData%Vars%x, x_glue, x_op) + + ! Select based on module ID + select case (ModData%ID) + case (Module_AD) + call AD_VarsUnpackContState(ModData%Vars, x_op, T%AD%x(iState)%rotors(ModData%Ins)) + case (Module_ADsk) + call ADsk_VarsUnpackContState(ModData%Vars, x_op, T%ADsk%x(iState)) + case (Module_BD) + call BD_VarsUnpackContState(ModData%Vars, x_op, T%BD%x(ModData%Ins, iState)) + case (Module_ED) + call ED_VarsUnpackContState(ModData%Vars, x_op, T%ED%x(ModData%Ins, iState)) + case (Module_SED) + call SED_VarsUnpackContState(ModData%Vars, x_op, T%SED%x(iState)) + case (Module_ExtPtfm) + call ExtPtfm_VarsUnpackContState(ModData%Vars, x_op, T%ExtPtfm%x(iState)) + case (Module_FEAM) + call FEAM_VarsUnpackContState(ModData%Vars, x_op, T%FEAM%x(iState)) + case (Module_HD) + call HydroDyn_VarsUnpackContState(ModData%Vars, x_op, T%HD%x(iState)) + case (Module_IceD) + call IceD_VarsUnpackContState(ModData%Vars, x_op, T%IceD%x(ModData%Ins, iState)) + case (Module_IceF) + call IceFloe_VarsUnpackContState(ModData%Vars, x_op, T%IceF%x(iState)) + case (Module_IfW) + call InflowWind_VarsUnpackContState(ModData%Vars, x_op, T%IfW%x(iState)) + case (Module_MAP) + call MAP_VarsUnpackContState(ModData%Vars, x_op, T%MAP%x(iState)) + case (Module_MD) + call MD_VarsUnpackContState(ModData%Vars, x_op, T%MD%x(iState)) + case (Module_ExtInfw) + ! call ExtInfw_VarsUnpackContState(ModData%Varsx_op,, T%ExtInfw%x(StateIndex)) + case (Module_Orca) + call Orca_VarsUnpackContState(ModData%Vars, x_op, T%Orca%x(iState)) + case (Module_SD) + call SD_VarsUnpackContState(ModData%Vars, x_op, T%SD%x(iState)) + case (Module_SeaSt) + call SeaSt_VarsUnpackContState(ModData%Vars, x_op, T%SeaSt%x(iState)) + case (Module_SrvD) + call SrvD_VarsUnpackContState(ModData%Vars, x_op, T%SrvD%x(iState)) + case default + call SetErrStat(ErrID_Fatal, "Continuous State unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select + + end if + + ! If constraint states are requested + if (present(z_op)) then + + ! If glue array is present, transfer from module to glue + if (present(z_glue)) call XfrGluToModAry(ModData%Vars%z, z_glue, z_op) + + ! Select based on module ID + select case (ModData%ID) + case (Module_AD) + call AD_VarsUnpackConstrState(ModData%Vars, z_op, T%AD%z(iState)%rotors(ModData%Ins)) + case (Module_ADsk) + call ADsk_VarsUnpackConstrState(ModData%Vars, z_op, T%ADsk%z(iState)) + case (Module_BD) + call BD_VarsUnpackConstrState(ModData%Vars, z_op, T%BD%z(ModData%Ins, iState)) + case (Module_ED) + call ED_VarsUnpackConstrState(ModData%Vars, z_op, T%ED%z(ModData%Ins, iState)) + case (Module_SED) + call SED_VarsUnpackConstrState(ModData%Vars, z_op, T%SED%z(iState)) + case (Module_ExtPtfm) + call ExtPtfm_VarsUnpackConstrState(ModData%Vars, z_op, T%ExtPtfm%z(iState)) + case (Module_FEAM) + call FEAM_VarsUnpackConstrState(ModData%Vars, z_op, T%FEAM%z(iState)) + case (Module_HD) + call HydroDyn_VarsUnpackConstrState(ModData%Vars, z_op, T%HD%z(iState)) + case (Module_IceD) + call IceD_VarsUnpackConstrState(ModData%Vars, z_op, T%IceD%z(ModData%Ins, iState)) + case (Module_IceF) + call IceFloe_VarsUnpackConstrState(ModData%Vars, z_op, T%IceF%z(iState)) + case (Module_IfW) + call InflowWind_VarsUnpackConstrState(ModData%Vars, z_op, T%IfW%z(iState)) + case (Module_MAP) + call MAP_VarsUnpackConstrState(ModData%Vars, z_op, T%MAP%z(iState)) + case (Module_MD) + call MD_VarsUnpackConstrState(ModData%Vars, z_op, T%MD%z(iState)) + case (Module_ExtInfw) + ! call ExtInfw_VarsUnpackConstrState(ModData%z_op,Vars, T%ExtInfw%z(StateIndex)) + case (Module_Orca) + call Orca_VarsUnpackConstrState(ModData%Vars, z_op, T%Orca%z(iState)) + case (Module_SD) + call SD_VarsUnpackConstrState(ModData%Vars, z_op, T%SD%z(iState)) + case (Module_SeaSt) + call SeaSt_VarsUnpackConstrState(ModData%Vars, z_op, T%SeaSt%z(iState)) + case (Module_SrvD) + call SrvD_VarsUnpackConstrState(ModData%Vars, z_op, T%SrvD%z(iState)) + case default + call SetErrStat(ErrID_Fatal, "Constraint State unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select + + end if + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine FAST_JacobianPInput(ModData, ThisTime, iInput, iState, T, ErrStat, ErrMsg, dYdu, dXdu, dYdu_glue, dXdu_glue) + type(ModDataType), intent(in) :: ModData !< Module data + real(DbKi), intent(in) :: ThisTime !< Time + integer(IntKi), intent(in) :: iInput !< Input index + integer(IntKi), intent(in) :: iState !< State index + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + real(R8Ki), allocatable, optional, intent(inout) :: dYdu(:, :) + real(R8Ki), allocatable, optional, intent(inout) :: dXdu(:, :) + real(R8Ki), optional, intent(inout) :: dYdu_glue(:, :) + real(R8Ki), optional, intent(inout) :: dXdu_glue(:, :) + + character(*), parameter :: RoutineName = 'FAST_JacobianPInput' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + + ! Select based on module ID + select case (ModData%ID) + + case (Module_AD) + call AD_JacobianPInput(ModData%Vars, ModData%Ins, ThisTime, T%AD%Input(iInput), T%AD%p, T%AD%x(iState), T%AD%xd(iState), & + T%AD%z(iState), T%AD%OtherSt(iState), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) + +! case (Module_ADsk) +! call ADsk_JacobianPInput(ModData%Vars, ThisTime, T%ADsk%Input(iInput), T%ADsk%p, T%ADsk%x(iState), T%ADsk%xd(iState), & +! T%ADsk%z(iState), T%ADsk%OtherSt(iState), T%ADsk%y, T%ADsk%m, ErrStat2, ErrMsg2, & +! dYdu=dYdu, dXdu=dXdu) + + case (Module_BD) + call BD_JacobianPInput(ModData%Vars, ThisTime, T%BD%Input(iInput, ModData%Ins), T%BD%p(ModData%Ins), & + T%BD%x(ModData%Ins, iState), T%BD%xd(ModData%Ins, iState), & + T%BD%z(ModData%Ins, iState), T%BD%OtherSt(ModData%Ins, iState), & + T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) + + case (Module_ED) + call ED_JacobianPInput(ModData%Vars, ThisTime, T%ED%Input(iInput, ModData%Ins), T%ED%p(ModData%Ins), & + T%ED%x(ModData%Ins, iState), T%ED%xd(ModData%Ins, iState), & + T%ED%z(ModData%Ins, iState), T%ED%OtherSt(ModData%Ins, iState), & + T%ED%y(ModData%Ins), T%ED%m(ModData%Ins), ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) + + case (Module_SED) + call SED_JacobianPInput(ModData%Vars, ThisTime, T%SED%Input(iInput), T%SED%p, T%SED%x(iState), T%SED%xd(iState), & + T%SED%z(iState), T%SED%OtherSt(iState), T%SED%y, T%SED%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) + + case (Module_ExtPtfm) + call ExtPtfm_JacobianPInput(ModData%Vars, ThisTime, T%ExtPtfm%Input(iInput), T%ExtPtfm%p, T%ExtPtfm%x(iState), T%ExtPtfm%xd(iState), & + T%ExtPtfm%z(iState), T%ExtPtfm%OtherSt(iState), T%ExtPtfm%y, T%ExtPtfm%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) + + case (Module_HD) + call HD_JacobianPInput(ModData%Vars, ThisTime, T%HD%Input(iInput), T%HD%p, T%HD%x(iState), T%HD%xd(iState), & + T%HD%z(iState), T%HD%OtherSt(iState), T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) + + case (Module_IfW) + call InflowWind_JacobianPInput(ModData%Vars, ThisTime, T%IfW%Input(iInput), T%IfW%p, T%IfW%x(iState), T%IfW%xd(iState), & + T%IfW%z(iState), T%IfW%OtherSt(iState), T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) + + case (Module_MAP) + call MAP_JacobianPInput(ModData%Vars, ThisTime, T%MAP%Input(iInput), T%MAP%p, T%MAP%x(iState), T%MAP%xd(iState), & + T%MAP%z(iState), T%MAP%OtherSt, T%MAP%y, T%MAP%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) + + case (Module_MD) + call MD_JacobianPInput(ModData%Vars, ThisTime, T%MD%Input(iInput), T%MD%p, T%MD%x(iState), T%MD%xd(iState), & + T%MD%z(iState), T%MD%OtherSt(iState), T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) + + case (Module_SD) + call SD_JacobianPInput(ModData%Vars, ThisTime, T%SD%Input(iInput), T%SD%p, T%SD%x(iState), T%SD%xd(iState), & + T%SD%z(iState), T%SD%OtherSt(iState), T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) + + case (Module_SeaSt) + call SeaSt_JacobianPInput(ModData%Vars, ThisTime, T%SeaSt%Input(iInput), T%SeaSt%p, T%SeaSt%x(iState), T%SeaSt%xd(iState), & + T%SeaSt%z(iState), T%SeaSt%OtherSt(iState), T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & + dYdu=dYdu, dXdu=dXdu) + + case (Module_SrvD) + call SrvD_JacobianPInput(ThisTime, T%SrvD%Input(iInput), T%SrvD%p, T%SrvD%x(iState), T%SrvD%xd(iState), & + T%SrvD%z(iState), T%SrvD%OtherSt(iState), T%SrvD%y, T%SrvD%m, & + ErrStat2, ErrMsg2, dYdu=dYdu, dXdu=dXdu) + + case default + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Unsupported module ID: "//ModData%Abbr + end select + + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + ! If dYdu and dYdu_glue are present, transfer from module matrix to glue matrix + if (present(dYdu) .and. present(dYdu_glue)) call XfrModToGlueMatrix(ModData%Vars%y, ModData%Vars%u, dYdu, dYdu_glue) + + ! If dXdu and dXdu_glue are present, transfer from module matrix to glue matrix + if (present(dXdu) .and. present(dXdu_glue)) call XfrModToGlueMatrix(ModData%Vars%x, ModData%Vars%u, dXdu, dXdu_glue) + +end subroutine + +subroutine FAST_JacobianPContState(ModData, ThisTime, iInput, iState, T, ErrStat, ErrMsg, dYdx, dXdx, dYdx_glue, dXdx_glue) + type(ModDataType), intent(inout) :: ModData !< Module data + real(DbKi), intent(in) :: ThisTime !< Time + integer(IntKi), intent(in) :: iInput !< Input index + integer(IntKi), intent(in) :: iState !< State index + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + real(R8Ki), allocatable, optional, intent(inout) :: dYdx(:, :) + real(R8Ki), allocatable, optional, intent(inout) :: dXdx(:, :) + real(R8Ki), optional, intent(inout) :: dYdx_glue(:, :) + real(R8Ki), optional, intent(inout) :: dXdx_glue(:, :) + + character(*), parameter :: RoutineName = 'FAST_JacobianPContState' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + + ! Select based on module ID + select case (ModData%ID) + + case (Module_AD) + call AD_JacobianPContState(ModData%Vars, ModData%Ins, ThisTime, T%AD%Input(iInput), T%AD%p, & + T%AD%x(iState), T%AD%xd(iState), & + T%AD%z(iState), T%AD%OtherSt(iState), & + T%AD%y, T%AD%m, ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx) + +! case (Module_ADsk) + + case (Module_BD) + call BD_JacobianPContState(ModData%Vars, ThisTime, T%BD%Input(iInput, ModData%Ins), T%BD%p(ModData%Ins), & + T%BD%x(ModData%Ins, iState), T%BD%xd(ModData%Ins, iState), & + T%BD%z(ModData%Ins, iState), T%BD%OtherSt(ModData%Ins, iState), & + T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx, StateRotation=ModData%Lin%StateRotation) + + case (Module_ED) + call ED_JacobianPContState(ModData%Vars, ThisTime, T%ED%Input(iInput, ModData%Ins), T%ED%p(ModData%Ins), & + T%ED%x(ModData%Ins, iState), T%ED%xd(ModData%Ins, iState), & + T%ED%z(ModData%Ins, iState), T%ED%OtherSt(ModData%Ins, iState), & + T%ED%y(ModData%Ins), T%ED%m(ModData%Ins), ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx) + + case (Module_SED) + call SED_JacobianPContState(ModData%Vars, ThisTime, T%SED%Input(iInput), T%SED%p, & + T%SED%x(iState), T%SED%xd(iState), & + T%SED%z(iState), T%SED%OtherSt(iState), & + T%SED%y, T%SED%m, ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx) + + case (Module_ExtPtfm) + call ExtPtfm_JacobianPContState(ThisTime, T%ExtPtfm%Input(iInput), T%ExtPtfm%p, & + T%ExtPtfm%x(iState), T%ExtPtfm%xd(iState), & + T%ExtPtfm%z(iState), T%ExtPtfm%OtherSt(iState), & + T%ExtPtfm%y, T%ExtPtfm%m, ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx) + + case (Module_HD) + call HD_JacobianPContState(ModData%Vars, ThisTime, T%HD%Input(iInput), T%HD%p, & + T%HD%x(iState), T%HD%xd(iState), & + T%HD%z(iState), T%HD%OtherSt(iState), & + T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx) + + case (Module_IfW) + call InflowWind_JacobianPContState(ModData%Vars, ThisTime, T%IfW%Input(iInput), T%IfW%p, & + T%IfW%x(iState), T%IfW%xd(iState), & + T%IfW%z(iState), T%IfW%OtherSt(iState), & + T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx) + + case (Module_MAP) + ! MAP doesn't have a JacobianPContState subroutine + ErrStat2 = ErrID_None + ErrMsg2 = '' + + case (Module_MD) + call MD_JacobianPContState(ModData%Vars, ThisTime, T%MD%Input(iInput), T%MD%p, & + T%MD%x(iState), T%MD%xd(iState), & + T%MD%z(iState), T%MD%OtherSt(iState), & + T%MD%y, T%MD%m, ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx) + + case (Module_SD) + call SD_JacobianPContState(ModData%Vars, ThisTime, T%SD%Input(iInput), T%SD%p, & + T%SD%x(iState), T%SD%xd(iState), & + T%SD%z(iState), T%SD%OtherSt(iState), & + T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx) + + case (Module_SeaSt) + call SeaSt_JacobianPContState(ModData%Vars, ThisTime, T%SeaSt%Input(iInput), T%SeaSt%p, & + T%SeaSt%x(iState), T%SeaSt%xd(iState), & + T%SeaSt%z(iState), T%SeaSt%OtherSt(iState), & + T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx) + + case (Module_SrvD) + call SrvD_JacobianPContState(ThisTime, T%SrvD%Input(iInput), T%SrvD%p, & + T%SrvD%x(iState), T%SrvD%xd(iState), & + T%SrvD%z(iState), T%SrvD%OtherSt(iState), & + T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2, & + dYdx=dYdx, dXdx=dXdx) + + case default + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Unsupported module ID: "//ModData%Abbr + end select + + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + ! If dYdx and dYdx_glue are present, transfer from module matrix to glue matrix + if (present(dYdx) .and. present(dYdx_glue)) call XfrModToGlueMatrix(ModData%Vars%y, ModData%Vars%x, dYdx, dYdx_glue) + + ! If dXdx and dXdx_glue are present, transfer from module matrix to glue matrix + if (present(dXdx) .and. present(dXdx_glue)) call XfrModToGlueMatrix(ModData%Vars%x, ModData%Vars%x, dXdx, dXdx_glue) + +end subroutine + +subroutine FAST_CopyStates(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData !< Module data + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(in) :: iSrc, iDst !< State indices + integer(IntKi), intent(in) :: CtrlCode !< Mesh copy code + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_CopyStates' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + integer(IntKi) :: i, j + integer(IntKi) :: j_ss ! substep loop counter + integer(IntKi) :: n_t_module ! simulation time step, loop counter for individual modules + real(DbKi) :: t_module ! Current simulation time for module + + ErrStat = ErrID_None + ErrMsg = '' + + ! Select based on module ID + select case (ModData%ID) + + case (Module_AD) + + call AD_CopyContState(T%AD%x(iSrc), T%AD%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call AD_CopyDiscState(T%AD%xd(iSrc), T%AD%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call AD_CopyConstrState(T%AD%z(iSrc), T%AD%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call AD_CopyOtherState(T%AD%OtherSt(iSrc), T%AD%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_ADsk) + + call ADsk_CopyContState(T%ADsk%x(iSrc), T%ADsk%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ADsk_CopyDiscState(T%ADsk%xd(iSrc), T%ADsk%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ADsk_CopyConstrState(T%ADsk%z(iSrc), T%ADsk%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ADsk_CopyOtherState(T%ADsk%OtherSt(iSrc), T%ADsk%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_BD) + + call BD_CopyContState(T%BD%x(ModData%Ins, iSrc), T%BD%x(ModData%Ins, iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyDiscState(T%BD%xd(ModData%Ins, iSrc), T%BD%xd(ModData%Ins, iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyConstrState(T%BD%z(ModData%Ins, iSrc), T%BD%z(ModData%Ins, iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyOtherState(T%BD%OtherSt(ModData%Ins, iSrc), T%BD%OtherSt(ModData%Ins, iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_ED) + + call ED_CopyContState(T%ED%x(ModData%Ins, iSrc), T%ED%x(ModData%Ins, iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyDiscState(T%ED%xd(ModData%Ins, iSrc), T%ED%xd(ModData%Ins, iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyConstrState(T%ED%z(ModData%Ins, iSrc), T%ED%z(ModData%Ins, iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyOtherState(T%ED%OtherSt(ModData%Ins, iSrc), T%ED%OtherSt(ModData%Ins, iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_SED) + + call SED_CopyContState(T%SED%x(iSrc), T%SED%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SED_CopyDiscState(T%SED%xd(iSrc), T%SED%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SED_CopyConstrState(T%SED%z(iSrc), T%SED%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SED_CopyOtherState(T%SED%OtherSt(iSrc), T%SED%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_ExtInfw) + + ! call ExtInfw_CopyContState(T%ExtInfw%x(Src), T%ExtInfw%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call ExtInfw_CopyDiscState(T%ExtInfw%xd(Src), T%ExtInfw%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call ExtInfw_CopyConstrState(T%ExtInfw%z(Src), T%ExtInfw%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call ExtInfw_CopyOtherState(T%ExtInfw%OtherSt(Src), T%ExtInfw%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_ExtLd) + + call ExtLd_CopyContState(T%ExtLd%x(iSrc), T%ExtLd%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ExtLd_CopyDiscState(T%ExtLd%xd(iSrc), T%ExtLd%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ExtLd_CopyConstrState(T%ExtLd%z(iSrc), T%ExtLd%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ExtLd_CopyOtherState(T%ExtLd%OtherSt(iSrc), T%ExtLd%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_ExtPtfm) + + call ExtPtfm_CopyContState(T%ExtPtfm%x(iSrc), T%ExtPtfm%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ExtPtfm_CopyDiscState(T%ExtPtfm%xd(iSrc), T%ExtPtfm%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ExtPtfm_CopyConstrState(T%ExtPtfm%z(iSrc), T%ExtPtfm%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ExtPtfm_CopyOtherState(T%ExtPtfm%OtherSt(iSrc), T%ExtPtfm%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_FEAM) + + call FEAM_CopyContState(T%FEAM%x(iSrc), T%FEAM%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call FEAM_CopyDiscState(T%FEAM%xd(iSrc), T%FEAM%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call FEAM_CopyConstrState(T%FEAM%z(iSrc), T%FEAM%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call FEAM_CopyOtherState(T%FEAM%OtherSt(iSrc), T%FEAM%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_HD) + + call HydroDyn_CopyContState(T%HD%x(iSrc), T%HD%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call HydroDyn_CopyDiscState(T%HD%xd(iSrc), T%HD%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call HydroDyn_CopyConstrState(T%HD%z(iSrc), T%HD%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call HydroDyn_CopyOtherState(T%HD%OtherSt(iSrc), T%HD%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_IceD) + + call IceD_CopyContState(T%IceD%x(iSrc, ModData%Ins), T%IceD%x(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call IceD_CopyDiscState(T%IceD%xd(iSrc, ModData%Ins), T%IceD%xd(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call IceD_CopyConstrState(T%IceD%z(iSrc, ModData%Ins), T%IceD%z(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call IceD_CopyOtherState(T%IceD%OtherSt(iSrc, ModData%Ins), T%IceD%OtherSt(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_IceF) + + call IceFloe_CopyContState(T%IceF%x(iSrc), T%IceF%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call IceFloe_CopyDiscState(T%IceF%xd(iSrc), T%IceF%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call IceFloe_CopyConstrState(T%IceF%z(iSrc), T%IceF%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call IceFloe_CopyOtherState(T%IceF%OtherSt(iSrc), T%IceF%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_IfW) + + ! call IfW_CopyContState(T%IfW%x(Src), T%IfW%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call IfW_CopyDiscState(T%IfW%xd(Src), T%IfW%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call IfW_CopyConstrState(T%IfW%z(Src), T%IfW%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call IfW_CopyOtherState(T%IfW%OtherSt(Src), T%IfW%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_MAP) + + call MAP_CopyContState(T%MAP%x(iSrc), T%MAP%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call MAP_CopyDiscState(T%MAP%xd(iSrc), T%MAP%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call MAP_CopyConstrState(T%MAP%z(iSrc), T%MAP%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call MAP_CopyOtherState(T%MAP%OtherSt(Src), T%MAP%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_MD) + + call MD_CopyContState(T%MD%x(iSrc), T%MD%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call MD_CopyDiscState(T%MD%xd(iSrc), T%MD%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call MD_CopyConstrState(T%MD%z(iSrc), T%MD%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call MD_CopyOtherState(T%MD%OtherSt(iSrc), T%MD%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_Orca) + + call Orca_CopyContState(T%Orca%x(iSrc), T%Orca%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call Orca_CopyDiscState(T%Orca%xd(iSrc), T%Orca%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call Orca_CopyConstrState(T%Orca%z(iSrc), T%Orca%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call Orca_CopyOtherState(T%Orca%OtherSt(iSrc), T%Orca%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_SD) + + call SD_CopyContState(T%SD%x(iSrc), T%SD%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SD_CopyDiscState(T%SD%xd(iSrc), T%SD%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SD_CopyConstrState(T%SD%z(iSrc), T%SD%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SD_CopyOtherState(T%SD%OtherSt(iSrc), T%SD%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_SeaSt) + + call SeaSt_CopyContState(T%SeaSt%x(iSrc), T%SeaSt%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SeaSt_CopyDiscState(T%SeaSt%xd(iSrc), T%SeaSt%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SeaSt_CopyConstrState(T%SeaSt%z(iSrc), T%SeaSt%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SeaSt_CopyOtherState(T%SeaSt%OtherSt(iSrc), T%SeaSt%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_SrvD) + + call SrvD_CopyContState(T%SrvD%x(iSrc), T%SrvD%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SrvD_CopyDiscState(T%SrvD%xd(iSrc), T%SrvD%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SrvD_CopyConstrState(T%SrvD%z(iSrc), T%SrvD%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SrvD_CopyOtherState(T%SrvD%OtherSt(iSrc), T%SrvD%OtherSt(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case default + call SetErrStat(ErrID_Fatal, "Unknown module "//trim(ModData%Abbr), ErrStat, ErrMsg, RoutineName) + return + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData !< Module data + type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type + integer(IntKi), intent(in) :: iSrc, iDst !< Input indices + integer(IntKi), intent(in) :: CtrlCode !< Mesh copy code + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_CopyInput' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + integer(IntKi) :: i, j, k + + ErrStat = ErrID_None + ErrMsg = '' + + ! If source and destination indices are the same, return error + if (iSrc == iDst) then + call SetErrStat(ErrID_Fatal, "invalid indices: iSrc == iDst", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Select based on module ID + select case (ModData%ID) + + case (Module_AD) + call AD_CopyInput(T%AD%Input(iSrc), T%AD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + + case (Module_ADsk) + call ADsk_CopyInput(T%ADsk%Input(iSrc), T%ADsk%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + + case (Module_BD) + call BD_CopyInput(T%BD%Input(iSrc, ModData%Ins), T%BD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) + + case (Module_ED) + call ED_CopyInput(T%ED%Input(iSrc, ModData%Ins), T%ED%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) + + case (Module_SED) + call SED_CopyInput(T%SED%Input(iSrc), T%SED%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + + case (Module_ExtLd) + ! ExtLd only has u + Errstat2 = ErrID_None + ErrMsg2 = '' + + case (Module_ExtPtfm) + call ExtPtfm_CopyInput(T%ExtPtfm%Input(iSrc), T%ExtPtfm%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + + case (Module_FEAM) + call FEAM_CopyInput(T%FEAM%Input(iSrc), T%FEAM%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + + case (Module_HD) + call HydroDyn_CopyInput(T%HD%Input(iSrc), T%HD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + + case (Module_IceD) + call IceD_CopyInput(T%IceD%Input(iSrc, ModData%Ins), T%IceD%Input(iDst, ModData%Ins), CtrlCode, Errstat2, ErrMsg2) + + case (Module_IceF) + call IceFloe_CopyInput(T%IceF%Input(iSrc), T%IceF%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + + case (Module_IfW) + call InflowWind_CopyInput(T%IfW%Input(iSrc), T%IfW%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + + case (Module_MAP) + call MAP_CopyInput(T%MAP%Input(iSrc), T%MAP%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + + case (Module_MD) + call MD_CopyInput(T%MD%Input(iSrc), T%MD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + +! case (Module_ExtInfw) + + case (Module_Orca) + call Orca_CopyInput(T%Orca%Input(iSrc), T%Orca%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + + case (Module_SD) + call SD_CopyInput(T%SD%Input(iSrc), T%SD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + + case (Module_SeaSt) + call SeaSt_CopyInput(T%SeaSt%Input(iSrc), T%SeaSt%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + + case (Module_SrvD) + call SrvD_CopyInput(T%SrvD%Input(iSrc), T%SrvD%Input(iDst), CtrlCode, Errstat2, ErrMsg2) + + case default + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Unknown module "//trim(ModData%Abbr) + end select + + ! Set error + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + +end subroutine + +subroutine XfrLocToGluAry(VarAry, ModAry, GluAry) + type(ModVarType), intent(in) :: VarAry(:) + real(R8Ki), allocatable, intent(in) :: ModAry(:) + real(R8Ki), intent(inout) :: GluAry(:) + integer(IntKi) :: i + if (.not. allocated(ModAry) .or. size(VarAry) == 0) return + do i = 1, size(VarAry) + GluAry(VarAry(i)%iGlu(1):VarAry(i)%iGlu(2)) = ModAry(VarAry(i)%iLoc(1):VarAry(i)%iLoc(2)) + end do +end subroutine + +subroutine XfrGluToModAry(VarAry, GluAry, ModAry) + type(ModVarType), intent(in) :: VarAry(:) + real(R8Ki), allocatable, intent(in) :: GluAry(:) + real(R8Ki), intent(inout) :: ModAry(:) + integer(IntKi) :: i + if (.not. allocated(GluAry) .or. size(VarAry) == 0) return + do i = 1, size(VarAry) + ModAry(VarAry(i)%iLoc(1):VarAry(i)%iLoc(2)) = GluAry(VarAry(i)%iGlu(1):VarAry(i)%iGlu(2)) + end do +end subroutine + +subroutine XfrModToGlueMatrix(RowVarAry, ColVarAry, ModMat, GluMat) + type(ModVarType), intent(in) :: RowVarAry(:), ColVarAry(:) + real(R8Ki), allocatable, intent(in) :: ModMat(:, :) + real(R8Ki), intent(inout) :: GluMat(:, :) + integer(IntKi) :: i, j + if (.not. allocated(ModMat) .or. size(RowVarAry) == 0 .or. size(ColVarAry) == 0) return + do i = 1, size(ColVarAry) + do j = 1, size(RowVarAry) + GluMat(RowVarAry(j)%iGlu(1):RowVarAry(j)%iGlu(2), ColVarAry(i)%iGlu(1):ColVarAry(i)%iGlu(2)) = & + ModMat(RowVarAry(j)%iLoc(1):RowVarAry(j)%iLoc(2), ColVarAry(i)%iLoc(1):ColVarAry(i)%iLoc(2)) + end do + end do +end subroutine + +subroutine FAST_ModEnd(Mods, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: Mods(:) !< Module data + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_CopyInput' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + ! Loop through modules and call end function + do i = 1, size(Mods) + associate (ModData => Mods(i)) + + ! Select based on module ID + select case (ModData%ID) + + case (Module_AD) + ! Call end on first instance since each rotor has an instance + if (ModData%Ins == 1) then + call AD_End(T%AD%Input(1), T%AD%p, T%AD%x(STATE_CURR), & + T%AD%xd(STATE_CURR), T%AD%z(STATE_CURR), & + T%AD%OtherSt(STATE_CURR), T%AD%y, T%AD%m, ErrStat2, ErrMsg2) + end if + + case (Module_ADsk) + call ADsk_End(T%ADsk%Input(1), T%ADsk%p, T%ADsk%x(STATE_CURR), & + T%ADsk%xd(STATE_CURR), T%ADsk%z(STATE_CURR), & + T%ADsk%OtherSt(STATE_CURR), T%ADsk%y, T%ADsk%m, ErrStat2, ErrMsg2) + + case (Module_BD) + call BD_End(T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), & + T%BD%x(ModData%Ins, STATE_CURR), T%BD%xd(ModData%Ins, STATE_CURR), & + T%BD%z(ModData%Ins, STATE_CURR), T%BD%OtherSt(ModData%Ins, STATE_CURR), & + T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2) + + case (Module_ED) + call ED_End(T%ED%Input(1, ModData%Ins), T%ED%p(ModData%Ins), & + T%ED%x(ModData%Ins, STATE_CURR), T%ED%xd(ModData%Ins, STATE_CURR), & + T%ED%z(ModData%Ins, STATE_CURR), T%ED%OtherSt(ModData%Ins, STATE_CURR), & + T%ED%y(ModData%Ins), T%ED%m(ModData%Ins), ErrStat2, ErrMsg2) + + case (Module_SED) + call SED_End(T%SED%Input(1), T%SED%p, T%SED%x(STATE_CURR), & + T%SED%xd(STATE_CURR), T%SED%z(STATE_CURR), T%SED%OtherSt(STATE_CURR), & + T%SED%y, T%SED%m, ErrStat2, ErrMsg2) + + case (Module_ExtInfw) + ! Missing ExtInfw_End + ErrStat2 = ErrID_None + ErrMsg2 = '' + + case (Module_ExtLd) + call ExtLd_End(T%ExtLd%u, T%ExtLd%p, T%ExtLd%x(STATE_CURR), T%ExtLd%xd(STATE_CURR), & + T%ExtLd%z(STATE_CURR), T%ExtLd%OtherSt(STATE_CURR), & + T%ExtLd%y, T%ExtLd%m, ErrStat2, ErrMsg2) + + case (Module_ExtPtfm) + call ExtPtfm_End(T%ExtPtfm%Input(1), T%ExtPtfm%p, T%ExtPtfm%x(STATE_CURR), T%ExtPtfm%xd(STATE_CURR), & + T%ExtPtfm%z(STATE_CURR), T%ExtPtfm%OtherSt(STATE_CURR), T%ExtPtfm%y, T%ExtPtfm%m, ErrStat2, ErrMsg2) + + case (Module_FEAM) + call FEAM_End(T%FEAM%Input(1), T%FEAM%p, T%FEAM%x(STATE_CURR), T%FEAM%xd(STATE_CURR), T%FEAM%z(STATE_CURR), & + T%FEAM%OtherSt(STATE_CURR), T%FEAM%y, T%FEAM%m, ErrStat2, ErrMsg2) + + case (Module_HD) + call HydroDyn_End(T%HD%Input(1), T%HD%p, T%HD%x(STATE_CURR), T%HD%xd(STATE_CURR), T%HD%z(STATE_CURR), T%HD%OtherSt(STATE_CURR), & + T%HD%y, T%HD%m, ErrStat2, ErrMsg2) + + case (Module_IceD) + call IceD_End(T%IceD%Input(1, ModData%Ins), T%IceD%p(ModData%Ins), & + T%IceD%x(ModData%Ins, STATE_CURR), T%IceD%xd(ModData%Ins, STATE_CURR), & + T%IceD%z(ModData%Ins, STATE_CURR), T%IceD%OtherSt(ModData%Ins, STATE_CURR), & + T%IceD%y(ModData%Ins), T%IceD%m(ModData%Ins), ErrStat2, ErrMsg2) + + case (Module_IceF) + call IceFloe_End(T%IceF%Input(1), T%IceF%p, T%IceF%x(STATE_CURR), T%IceF%xd(STATE_CURR), & + T%IceF%z(STATE_CURR), T%IceF%OtherSt(STATE_CURR), T%IceF%y, T%IceF%m, ErrStat2, ErrMsg2) + + case (Module_IfW) + call InflowWind_End(T%IfW%Input(1), T%IfW%p, T%IfW%x(STATE_CURR), T%IfW%xd(STATE_CURR), & + T%IfW%z(STATE_CURR), T%IfW%OtherSt(STATE_CURR), T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2) + + case (Module_MAP) + call MAP_End(T%MAP%Input(1), T%MAP%p, T%MAP%x(STATE_CURR), T%MAP%xd(STATE_CURR), & + T%MAP%z(STATE_CURR), T%MAP%OtherSt, T%MAP%y, ErrStat2, ErrMsg2) + + case (Module_MD) + call MD_End(T%MD%Input(1), T%MD%p, T%MD%x(STATE_CURR), T%MD%xd(STATE_CURR), T%MD%z(STATE_CURR), & + T%MD%OtherSt(STATE_CURR), T%MD%y, T%MD%m, ErrStat2, ErrMsg2) + + case (Module_Orca) + call Orca_End(T%Orca%Input(1), T%Orca%p, T%Orca%x(STATE_CURR), T%Orca%xd(STATE_CURR), & + T%Orca%z(STATE_CURR), T%Orca%OtherSt(STATE_CURR), T%Orca%y, T%Orca%m, ErrStat2, ErrMsg2) + + case (Module_SD) + call SD_End(T%SD%Input(1), T%SD%p, T%SD%x(STATE_CURR), T%SD%xd(STATE_CURR), & + T%SD%z(STATE_CURR), T%SD%OtherSt(STATE_CURR), & + T%SD%y, T%SD%m, ErrStat2, ErrMsg2) + + case (Module_SeaSt) + call SeaSt_End(T%SeaSt%Input(1), T%SeaSt%p, T%SeaSt%x(STATE_CURR), T%SeaSt%xd(STATE_CURR), & + T%SeaSt%z(STATE_CURR), T%SeaSt%OtherSt(STATE_CURR), & + T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2) + + case (Module_SrvD) + call SrvD_End(T%SrvD%Input(1), T%SrvD%p, T%SrvD%x(STATE_CURR), T%SrvD%xd(STATE_CURR), & + T%SrvD%z(STATE_CURR), T%SrvD%OtherSt(STATE_CURR), & + T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2) + + case default + call SetErrStat(ErrID_Fatal, "Unknown module "//trim(ModData%Abbr), ErrStat, ErrMsg, RoutineName) + return + end select + + end associate + + ! Collect errors + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +end module diff --git a/modules/openfast-library/src/FAST_Library.f90 b/modules/openfast-library/src/FAST_Library.f90 index 6a957dcf6f..5c374b0c5d 100644 --- a/modules/openfast-library/src/FAST_Library.f90 +++ b/modules/openfast-library/src/FAST_Library.f90 @@ -24,6 +24,7 @@ MODULE FAST_Data INTEGER(IntKi), PARAMETER :: MAXOUTPUTS = 4000 ! Maximum number of outputs INTEGER(IntKi), PARAMETER :: MAXInitINPUTS = 53 ! Maximum number of initialization values from Simulink INTEGER(IntKi), PARAMETER :: NumFixedInputs = 51 + integer(IntKi), parameter, private :: iED = 1 ! Global (static) data: @@ -311,7 +312,7 @@ subroutine FAST_Update(iTurb_c, NumInputs_c, NumOutputs_c, InputAry, OutputAry, ErrMsg = TRIM(ErrMsg)//NewLine//TRIM(ErrMsg2) end if - IF ( Turbine(iTurb)%m_FAST%Lin%FoundSteady) THEN + IF ( Turbine(iTurb)%m_Glue%CS%FoundSteady) THEN EndSimulationEarly = .TRUE. END IF @@ -358,16 +359,16 @@ subroutine FAST_HubPosition(iTurb_c, AbsPosition_c, RotationalVel_c, Orientation return end if - if (.NOT. Turbine(iTurb)%ED%y%HubPtMotion%Committed) then + if (.NOT. Turbine(iTurb)%ED%y(iED)%HubPtMotion%Committed) then ErrStat_c = ErrID_Fatal ErrMsg = "HubPtMotion mesh has not been committed."//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) return end if - AbsPosition_c = REAL(Turbine(iTurb)%ED%y%HubPtMotion%Position(:,1), C_FLOAT) + REAL(Turbine(iTurb)%ED%y%HubPtMotion%TranslationDisp(:,1), C_FLOAT) - Orientation_c = reshape( Turbine(iTurb)%ED%y%HubPtMotion%Orientation(1:3,1:3,1), (/9/) ) - RotationalVel_c = Turbine(iTurb)%ED%y%HubPtMotion%RotationVel(:,1) + AbsPosition_c = REAL(Turbine(iTurb)%ED%y(iED)%HubPtMotion%Position(:,1), C_FLOAT) + REAL(Turbine(iTurb)%ED%y(iED)%HubPtMotion%TranslationDisp(:,1), C_FLOAT) + Orientation_c = reshape( Turbine(iTurb)%ED%y(iED)%HubPtMotion%Orientation(1:3,1:3,1), (/9/) ) + RotationalVel_c = Turbine(iTurb)%ED%y(iED)%HubPtMotion%RotationVel(:,1) end subroutine FAST_HubPosition !================================================================================================================================== @@ -600,7 +601,7 @@ subroutine FAST_ExtLoads_Init(iTurb_c, TMax, InputFileName_c, TurbIDforName, Out dt_c = DBLE(Turbine(iTurb)%p_FAST%DT) - NumBl_c = Turbine(iTurb)%ED%p%NumBl + NumBl_c = Turbine(iTurb)%ED%p(iED)%NumBl CompLoadsType = Turbine(iTurb)%p_FAST%CompAero @@ -998,7 +999,7 @@ subroutine FAST_ExtLoads_Restart(iTurb_c, CheckpointRootName_c, AbortErrLev_c, d n_t_global_c = n_t_global AbortErrLev_c = AbortErrLev NumOuts_c = min(MAXOUTPUTS, 1 + SUM( Turbine(iTurb)%y_FAST%numOuts )) ! includes time - numblades_c = Turbine(iTurb)%ED%p%NumBl + numblades_c = Turbine(iTurb)%ED%p(iED)%NumBl dt_c = Turbine(iTurb)%p_FAST%dt #ifdef CONSOLE_FILE diff --git a/modules/openfast-library/src/FAST_Lin.f90 b/modules/openfast-library/src/FAST_Lin.f90 index 7f4a9bf929..a714a1833a 100644 --- a/modules/openfast-library/src/FAST_Lin.f90 +++ b/modules/openfast-library/src/FAST_Lin.f90 @@ -979,7 +979,7 @@ end subroutine cleanup END SUBROUTINE FAST_Linearize_OP !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that writes the A,B,C,D matrices from linearization to a text file. -SUBROUTINE WrLinFile_txt_Head(t_global, p_FAST, y_FAST, LinData, FileName, Un, ErrStat, ErrMsg) +SUBROUTINE WrLinFile_txt_Head(t_global, p_FAST, y_FAST, LinData, FileName, Un, ModuleID, ErrStat, ErrMsg) INTEGER(IntKi), INTENT( OUT) :: Un !< unit number REAL(DbKi), INTENT(IN ) :: t_global !< current (global) simulation time @@ -987,6 +987,7 @@ SUBROUTINE WrLinFile_txt_Head(t_global, p_FAST, y_FAST, LinData, FileName, Un, E TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code TYPE(FAST_LinType), INTENT(IN ) :: LinData !< Linearization data for individual module or glue (coupled system) CHARACTER(*), INTENT(IN ) :: FileName !< root name of the linearization file to open for writing + integer(IntKi), INTENT(IN ) :: ModuleID !< module abbreviation INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -1091,30 +1092,30 @@ SUBROUTINE WrLinFile_txt_Head(t_global, p_FAST, y_FAST, LinData, FileName, Un, E !...................................................... if (n(Indx_x) > 0) then WRITE(Un, '(A)') 'Order of continuous states:' - call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_x, LinData%names_x, rotFrame=LinData%RotFrame_x, derivOrder=LinData%DerivOrder_x ) + call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_x, LinData%names_x, ModuleID, rotFrame=LinData%RotFrame_x, derivOrder=LinData%DerivOrder_x ) WRITE(Un, '(A)') 'Order of continuous state derivatives:' - call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_dx, LinData%names_x, rotFrame=LinData%RotFrame_x, deriv=.true., derivOrder=LinData%DerivOrder_x ) + call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_dx, LinData%names_x, ModuleID, rotFrame=LinData%RotFrame_x, deriv=.true., derivOrder=LinData%DerivOrder_x ) end if if (n(Indx_xd) > 0) then WRITE(Un, '(A)') 'Order of discrete states:' - call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_xd, LinData%names_xd ) + call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_xd, LinData%names_xd, ModuleID ) end if if (n(Indx_z) > 0) then WRITE(Un, '(A)') 'Order of constraint states:' - call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_z, LinData%names_z, rotFrame=LinData%RotFrame_z ) + call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_z, LinData%names_z, ModuleID, rotFrame=LinData%RotFrame_z ) end if if (n(Indx_u) > 0) then WRITE(Un, '(A)') 'Order of inputs:' - call WrLinFile_txt_Table(p_FAST, Un, "Column ", LinData%op_u, LinData%names_u, rotFrame=LinData%RotFrame_u, UseCol=LinData%use_u ) + call WrLinFile_txt_Table(p_FAST, Un, "Column ", LinData%op_u, LinData%names_u, ModuleID, rotFrame=LinData%RotFrame_u, UseCol=LinData%use_u ) end if if (n(Indx_y) > 0) then WRITE(Un, '(A)') 'Order of outputs:' - call WrLinFile_txt_Table(p_FAST, Un, "Row ", LinData%op_y, LinData%names_y, rotFrame=LinData%RotFrame_y, UseCol=LinData%use_y ) + call WrLinFile_txt_Table(p_FAST, Un, "Row ", LinData%op_y, LinData%names_y, ModuleID, rotFrame=LinData%RotFrame_y, UseCol=LinData%use_y ) end if !............. @@ -1150,22 +1151,19 @@ SUBROUTINE WrLinFile_txt_End(Un, p_FAST, LinData) ! StateRotation matrix if (allocated(LinData%StateRotation)) call WrPartialMatrix( LinData%StateRotation, Un, p_FAST%OutFmt, 'StateRotation' ) - ! RelState matrices - if (allocated(LinData%StateRel_x)) call WrPartialMatrix( LinData%StateRel_x, Un, p_FAST%OutFmt, 'State_Rel_x' ) - if (allocated(LinData%StateRel_xdot)) call WrPartialMatrix( LinData%StateRel_xdot, Un, p_FAST%OutFmt, 'State_Rel_xdot' ) - close(Un) Un = -1 END SUBROUTINE WrLinFile_txt_End !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, rotFrame, deriv, derivOrder, UseCol,start_indx) +SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, ModuleID, rotFrame, deriv, derivOrder, UseCol,start_indx) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< parameters INTEGER(IntKi), INTENT(IN ) :: Un !< unit number CHARACTER(*), INTENT(IN ) :: RowCol !< Row/Column description REAL(ReKi), INTENT(IN ) :: op(:) !< operating point values (possibly different size that Desc because of orientations) CHARACTER(LinChanLen), INTENT(IN ) :: names(:) !< Descriptions of the channels (names and units) + integer(IntKi), INTENT(IN ) :: ModuleID !< Module identifier logical, optional, INTENT(IN ) :: rotFrame(:) !< determines if this parameter is in the rotating frame logical, optional, intent(in ) :: deriv !< flag that tells us if we need to modify the channel names for derivatives (xdot) integer(IntKi), optional, intent(in ) :: derivOrder(:) !< Order of the time derivatives associated with the channel @@ -1187,9 +1185,10 @@ SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, rotFrame, deriv, d CHARACTER(100) :: FmtOrient CHARACTER(25) :: DerivStr CHARACTER(25) :: DerivUnitStr - + logical :: UsesWM + real(R8Ki) :: DCM(3,3) + integer(IntKi) :: row - if (present(deriv) ) then UseDerivNames = deriv else @@ -1238,14 +1237,41 @@ SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, rotFrame, deriv, d RotatingCol = .false. if (present(rotFrame)) RotatingCol = rotFrame(i) + + select case (ModuleID) + case (Module_Glue) + UsesWM = (index(names(i), "ED") == 1) .or. & + (index(names(i), "BD") == 1) + case (Module_ED, Module_BD) + UsesWM = .true. + case default + UsesWM = .false. + end select - if (index(names(i), ' orientation angle, node ') > 0 ) then ! make sure this matches what is written in PackMotionMesh_Names() - if (UseThisCol) then - WRITE(Un, FmtOrient) i_print, op(i_op), op(i_op+1), op(i_op+2), RotatingCol, DerivOrdCol, trim(names(i)) !//' [OP is a row of the DCM] - i_print = i_print + 1 + if (index(names(i), ' orientation angle, node ') > 0) then ! make sure this matches what is written in PackMotionMesh_Names() + if (UsesWM) then + if (UseThisCol) then + if (index(names(i), ' X orientation angle, node ') > 0) then + DCM = wm_to_dcm(real(op(i_op:i_op+2), R8Ki)) + row = 1 + else if (index(names(i), ' Y orientation angle, node ') > 0) then + DCM = wm_to_dcm(real(op(i_op-1:i_op+1), R8Ki)) + row = 2 + else if (index(names(i), ' Z orientation angle, node ') > 0) then + DCM = wm_to_dcm(real(op(i_op-2:i_op), R8Ki)) + row = 3 + end if + WRITE(Un, FmtOrient) i_print, dcm(row, 1), dcm(row, 2), dcm(row, 3), RotatingCol, DerivOrdCol, trim(names(i)) !//' [OP is a row of the DCM] + i_print = i_print + 1 + end if + i_op = i_op + 1 + else + if (UseThisCol) then + WRITE(Un, FmtOrient) i_print, op(i_op), op(i_op+1), op(i_op+2), RotatingCol, DerivOrdCol, trim(names(i)) !//' [OP is a row of the DCM] + i_print = i_print + 1 + end if + i_op = i_op + 3 end if - - i_op = i_op + 3 else if (UseThisCol) then if (UseDerivNames) then @@ -1255,7 +1281,6 @@ SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, rotFrame, deriv, d end if i_print = i_print + 1 end if - i_op = i_op + 1 end if end do @@ -1292,7 +1317,7 @@ SUBROUTINE WriteModuleLinearMatrices(ThisModule, ThisInstance, t_global, p_FAST, OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(ThisModule)) if (size(y_FAST%Lin%Modules(ThisModule)%Instance) > 1 .or. ThisModule==Module_BD) OutFileName = trim(OutFileName)//TRIM(num2lstr(ThisInstance)) - call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance), OutFileName, Un, ErrStat, ErrMsg ) + call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance), OutFileName, Un, ThisModule, ErrStat, ErrMsg ) if (ErrStat >=AbortErrLev) then if (Un > 0) close(Un) return diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 new file mode 100644 index 0000000000..bdebcdb664 --- /dev/null +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -0,0 +1,3385 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2024 National Renewable Energy Laboratory +! +! This file is part of FAST. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +!********************************************************************************************************************************** +!> This module contains routines used by FAST to map meshes and values between modules for transfering data and doing linearization. + +module FAST_Mapping + +use FAST_Types +use FAST_ModTypes +use ExtLoads + +implicit none + +private +public :: FAST_InitMappings +public :: FAST_LinearizeMappings +public :: FAST_ResetRemapFlags +public :: FAST_InputSolve +public :: FAST_ResetMappingReady +public :: FAST_InputFieldName, FAST_OutputFieldName + +integer(IntKi), parameter :: Xfr_Invalid = 0, & + Xfr_Point_to_Point = 1, & + Xfr_Line2_to_Point = 2, & + Xfr_Point_to_Line2 = 3, & + Xfr_Line2_to_Line2 = 4 + +character(24), parameter :: Custom_ED_to_ExtLd = 'ED -> ExtLd', & + Custom_SrvD_to_AD = 'SrvD -> AD', & + Custom_ED_to_ADsk = 'ED -> ADsk', & + Custom_SED_to_ADsk = 'SED -> ADsk', & + Custom_SED_to_IfW = 'SED -> IfW', & + Custom_ED_to_IfW = 'ED -> IfW', & + Custom_SrvD_to_IfW = 'SrvD -> IfW', & + Custom_BD_to_SrvD = 'BD -> SrvD', & + Custom_ED_to_SrvD = 'ED -> SrvD', & + Custom_SED_to_SrvD = 'SED -> SrvD', & + Custom_ExtInfw_to_SrvD = 'ExtInfw -> SrvD', & + Custom_IfW_to_SrvD = 'IfW -> SrvD', & + Custom_SrvD_to_ED = 'SrvD -> ED', & + Custom_SrvD_to_SED = 'SrvD -> SED', & + Custom_SrvD_to_SD = 'SrvD -> SD', & + Custom_SrvD_to_MD = 'SrvD -> MD', & + Custom_ED_Tower_Damping = 'ED Tower Damping', & + Custom_ED_Blade_Damping = 'ED Blade Damping', & + Custom_BD_Blade_Damping = 'BD Blade Damping' + +contains + +subroutine FAST_InputMeshPointer(ModData, Turbine, MeshLoc, Mesh, iInput, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData + type(DatLoc), intent(in) :: MeshLoc + type(FAST_TurbineType), target, intent(in) :: Turbine + type(MeshType), pointer, intent(out) :: Mesh + integer(IntKi), intent(in) :: iInput + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + ErrStat = ErrID_None + ErrMsg = "" + + nullify (Mesh) + + select case (ModData%ID) + case (Module_AD) + Mesh => AD_InputMeshPointer(Turbine%AD%Input(iInput)%rotors(ModData%Ins), MeshLoc) + case (Module_ADsk) + Mesh => ADsk_InputMeshPointer(Turbine%ADsk%Input(iInput), MeshLoc) + case (Module_BD) + Mesh => BD_InputMeshPointer(Turbine%BD%Input(iInput, ModData%Ins), MeshLoc) + case (Module_ED) + Mesh => ED_InputMeshPointer(Turbine%ED%Input(iInput, ModData%Ins), MeshLoc) + case (Module_SED) + Mesh => SED_InputMeshPointer(Turbine%SED%Input(iInput), MeshLoc) + case (Module_ExtInfw) + ! ExtInfw doesn't have the typical input structure, using u + Mesh => ExtInfw_InputMeshPointer(Turbine%ExtInfw%u, MeshLoc) + case (Module_ExtLd) + ! ExtLd doesn't have the typical input structure, using u + Mesh => ExtLd_InputMeshPointer(Turbine%ExtLd%u, MeshLoc) + case (Module_ExtPtfm) + Mesh => ExtPtfm_InputMeshPointer(Turbine%ExtPtfm%Input(iInput), MeshLoc) + case (Module_FEAM) + Mesh => FEAM_InputMeshPointer(Turbine%FEAM%Input(iInput), MeshLoc) + case (Module_HD) + Mesh => HydroDyn_InputMeshPointer(Turbine%HD%Input(iInput), MeshLoc) + case (Module_IceD) + Mesh => IceD_InputMeshPointer(Turbine%IceD%Input(iInput, ModData%Ins), MeshLoc) + case (Module_IceF) + Mesh => IceFloe_InputMeshPointer(Turbine%IceF%Input(iInput), MeshLoc) + case (Module_IfW) + Mesh => InflowWind_InputMeshPointer(Turbine%IfW%Input(iInput), MeshLoc) + case (Module_MAP) + Mesh => MAP_InputMeshPointer(Turbine%MAP%Input(iInput), MeshLoc) + case (Module_MD) + Mesh => MD_InputMeshPointer(Turbine%MD%Input(iInput), MeshLoc) + case (Module_Orca) + Mesh => Orca_InputMeshPointer(Turbine%Orca%Input(iInput), MeshLoc) + case (Module_SD) + Mesh => SD_InputMeshPointer(Turbine%SD%Input(iInput), MeshLoc) + case (Module_SeaSt) + Mesh => SeaSt_InputMeshPointer(Turbine%SeaSt%Input(iInput), MeshLoc) + case (Module_SrvD) + Mesh => SrvD_InputMeshPointer(Turbine%SrvD%Input(iInput), MeshLoc) + case default + ErrStat = ErrID_Fatal + ErrMsg = "Unsupported module: "//ModData%Abbr + return + end select + + if (.not. associated(Mesh)) then + ErrStat = ErrID_Fatal + ErrMsg = "Mesh not found in module "//ModData%Abbr// & + ", Num="//trim(Num2LStr(MeshLoc%Num))// & + ", i1="//trim(Num2LStr(MeshLoc%i1))// & + ", i2="//trim(Num2LStr(MeshLoc%i2))// & + ", i3="//trim(Num2LStr(MeshLoc%i3)) + return + end if +end subroutine + +subroutine FAST_OutputMeshPointer(ModData, Turbine, MeshLoc, Mesh, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData + type(DatLoc), intent(in) :: MeshLoc + type(FAST_TurbineType), target, intent(inout) :: Turbine + type(MeshType), pointer, intent(out) :: Mesh + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + ErrStat = ErrID_None + ErrMsg = "" + + nullify (Mesh) + + select case (ModData%ID) + case (Module_AD) + Mesh => AD_OutputMeshPointer(Turbine%AD%y%rotors(ModData%Ins), MeshLoc) + case (Module_ADsk) + Mesh => ADsk_OutputMeshPointer(Turbine%ADsk%y, MeshLoc) + case (Module_BD) + Mesh => BD_OutputMeshPointer(Turbine%BD%y(ModData%Ins), MeshLoc) + case (Module_ED) + Mesh => ED_OutputMeshPointer(Turbine%ED%y(ModData%Ins), MeshLoc) + case (Module_SED) + Mesh => SED_OutputMeshPointer(Turbine%SED%y, MeshLoc) + case (Module_ExtInfw) + Mesh => ExtInfw_OutputMeshPointer(Turbine%ExtInfw%y, MeshLoc) + case (Module_ExtLd) + Mesh => ExtLd_OutputMeshPointer(Turbine%ExtLd%y, MeshLoc) + case (Module_ExtPtfm) + Mesh => ExtPtfm_OutputMeshPointer(Turbine%ExtPtfm%y, MeshLoc) + case (Module_FEAM) + Mesh => FEAM_OutputMeshPointer(Turbine%FEAM%y, MeshLoc) + case (Module_HD) + Mesh => HydroDyn_OutputMeshPointer(Turbine%HD%y, MeshLoc) + case (Module_IceD) + Mesh => IceD_OutputMeshPointer(Turbine%IceD%y(ModData%Ins), MeshLoc) + case (Module_IceF) + Mesh => IceFloe_OutputMeshPointer(Turbine%IceF%y, MeshLoc) + case (Module_IfW) + Mesh => InflowWind_OutputMeshPointer(Turbine%IfW%y, MeshLoc) + case (Module_MAP) + Mesh => MAP_OutputMeshPointer(Turbine%MAP%y, MeshLoc) + case (Module_MD) + Mesh => MD_OutputMeshPointer(Turbine%MD%y, MeshLoc) + case (Module_Orca) + Mesh => Orca_OutputMeshPointer(Turbine%Orca%y, MeshLoc) + case (Module_SD) + Mesh => SD_OutputMeshPointer(Turbine%SD%y, MeshLoc) + case (Module_SeaSt) + Mesh => SeaSt_OutputMeshPointer(Turbine%SeaSt%y, MeshLoc) + case (Module_SrvD) + Mesh => SrvD_OutputMeshPointer(Turbine%SrvD%y, MeshLoc) + case default + ErrStat = ErrID_Fatal + ErrMsg = "Unsupported module: "//ModData%Abbr + return + end select + + if (.not. associated(Mesh)) then + ErrStat = ErrID_Fatal + ErrMsg = "Mesh not found in module "//ModData%Abbr// & + ", Num="//trim(Num2LStr(MeshLoc%Num))// & + ", i1="//trim(Num2LStr(MeshLoc%i1))// & + ", i2="//trim(Num2LStr(MeshLoc%i2))// & + ", i3="//trim(Num2LStr(MeshLoc%i3)) + return + end if +end subroutine + +function FAST_InputFieldName(ModData, DL) result(Name) + type(ModDataType), intent(in) :: ModData + type(DatLoc), intent(in) :: DL + character(42) :: Name, tmp + select case (ModData%ID) + case (Module_AD) + Name = trim(ModData%Abbr)//"%u%rotors("//trim(Num2LStr(ModData%Ins))//")" + select case (DL%Num) + case (1:) + tmp = AD_InputFieldName(DL) + Name = trim(Name)//tmp(2:) + case (AD_u_HWindSpeed) + Name = 'AD%u%HWindSpeed (Ext)' + case (AD_u_PLExp) + Name = 'AD%u%PLExp (Ext)' + case (AD_u_PropagationDir) + Name = 'AD%u%PropagationDir (Ext)' + end select + case (Module_ADsk) + Name = trim(ModData%Abbr)//"%"//ADsk_InputFieldName(DL) + case (Module_BD) + Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//BD_InputFieldName(DL) + case (Module_ED) + select case (DL%Num) + case (1:) + Name = trim(ModData%Abbr)//"%"//ED_InputFieldName(DL) + case (ED_u_BlPitchComC) + Name = 'ED%u%BlPitchComC (Ext)' + end select + case (Module_SED) + Name = trim(ModData%Abbr)//"%"//SED_InputFieldName(DL) + case (Module_ExtInfw) + Name = trim(ModData%Abbr)//"%"//ExtInfw_InputFieldName(DL) + case (Module_ExtLd) + Name = trim(ModData%Abbr)//"%"//ExtLd_InputFieldName(DL) + case (Module_ExtPtfm) + Name = trim(ModData%Abbr)//"%"//ExtPtfm_InputFieldName(DL) + case (Module_FEAM) + Name = trim(ModData%Abbr)//"%"//FEAM_InputFieldName(DL) + case (Module_HD) + select case (DL%Num) + case (1:) + Name = trim(ModData%Abbr)//"%"//HydroDyn_InputFieldName(DL) + case (HydroDyn_u_WaveElev0) + Name = 'HD%u%WaveElev0 (Ext)' + case (HydroDyn_u_HWindSpeed) + Name = 'HD%u%HWindSpeed (Ext)' + case (HydroDyn_u_PLexp) + Name = 'HD%u%PLexp (Ext)' + case (HydroDyn_u_PropagationDir) + Name = 'HD%u%PropagationDir (Ext)' + end select + case (Module_IceD) + Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//IceD_InputFieldName(DL) + case (Module_IceF) + Name = trim(ModData%Abbr)//"%"//IceFloe_InputFieldName(DL) + case (Module_IfW) + select case (DL%Num) + case (1:) + Name = trim(ModData%Abbr)//"%"//InflowWind_InputFieldName(DL) + case (InflowWind_u_HWindSpeed) + Name = 'IfW%u%HWindSpeed (Ext)' + case (InflowWind_u_PLexp) + Name = 'IfW%u%PLexp (Ext)' + case (InflowWind_u_PropagationDir) + Name = 'IfW%u%PropagationDir (Ext)' + end select + case (Module_MAP) + Name = trim(ModData%Abbr)//"%"//MAP_InputFieldName(DL) + case (Module_MD) + Name = trim(ModData%Abbr)//"%"//MD_InputFieldName(DL) + case (Module_Orca) + Name = trim(ModData%Abbr)//"%"//Orca_InputFieldName(DL) + case (Module_SD) + Name = trim(ModData%Abbr)//"%"//SD_InputFieldName(DL) + case (Module_SeaSt) + select case (DL%Num) + case (1:) + Name = trim(ModData%Abbr)//"%"//SeaSt_InputFieldName(DL) + case (SeaSt_u_WaveElev0) + Name = 'SeaSt%u%WaveElev0 (Ext)' + end select + case (Module_SrvD) + Name = trim(ModData%Abbr)//"%"//SrvD_InputFieldName(DL) + case default + Name = "Unknown field "//Num2LStr(DL%Num)//" in "//ModData%Abbr + end select +end function + +function FAST_OutputFieldName(ModData, DL) result(Name) + type(ModDataType), intent(in) :: ModData + type(DatLoc), intent(in) :: DL + character(42) :: Name, tmp + select case (ModData%ID) + case (Module_AD) + tmp = AD_OutputFieldName(DL) + Name = trim(ModData%Abbr)//"%y%rotors("//trim(Num2LStr(ModData%Ins))//")"//tmp(2:) + case (Module_ADsk) + Name = trim(ModData%Abbr)//"%"//ADsk_OutputFieldName(DL) + case (Module_BD) + Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//BD_OutputFieldName(DL) + case (Module_ED) + Name = trim(ModData%Abbr)//"%"//ED_OutputFieldName(DL) + case (Module_SED) + Name = trim(ModData%Abbr)//"%"//SED_OutputFieldName(DL) + case (Module_ExtInfw) + Name = trim(ModData%Abbr)//"%"//ExtInfw_OutputFieldName(DL) + case (Module_ExtLd) + Name = trim(ModData%Abbr)//"%"//ExtLd_OutputFieldName(DL) + case (Module_ExtPtfm) + Name = trim(ModData%Abbr)//"%"//ExtPtfm_OutputFieldName(DL) + case (Module_FEAM) + Name = trim(ModData%Abbr)//"%"//FEAM_OutputFieldName(DL) + case (Module_HD) + Name = trim(ModData%Abbr)//"%"//HydroDyn_OutputFieldName(DL) + case (Module_IceD) + Name = trim(ModData%Abbr)//"("//trim(Num2LStr(ModData%Ins))//")%"//IceD_OutputFieldName(DL) + case (Module_IceF) + Name = trim(ModData%Abbr)//"%"//IceFloe_OutputFieldName(DL) + case (Module_IfW) + select case (DL%Num) + case (1:) + Name = trim(ModData%Abbr)//"%"//InflowWind_OutputFieldName(DL) + case (InflowWind_y_HWindSpeed) + Name = 'IfW%y%HWindSpeed (Ext)' + case (InflowWind_y_PLexp) + Name = 'IfW%y%PLexp (Ext)' + case (InflowWind_y_PropagationDir) + Name = 'IfW%y%PropagationDir (Ext)' + end select + case (Module_MAP) + Name = trim(ModData%Abbr)//"%"//MAP_OutputFieldName(DL) + case (Module_MD) + Name = trim(ModData%Abbr)//"%"//MD_OutputFieldName(DL) + case (Module_Orca) + Name = trim(ModData%Abbr)//"%"//Orca_OutputFieldName(DL) + case (Module_SD) + Name = trim(ModData%Abbr)//"%"//SD_OutputFieldName(DL) + case (Module_SeaSt) + select case (DL%Num) + case (1:) + Name = trim(ModData%Abbr)//"%"//SeaSt_OutputFieldName(DL) + case (SeaSt_y_WaveElev0) + Name = 'SeaSt%y%WaveElev0 (Ext)' + end select + case (Module_SrvD) + Name = trim(ModData%Abbr)//"%"//SrvD_OutputFieldName(DL) + case default + Name = "Unknown field "//Num2LStr(DL%Num)//" in "//ModData%Abbr + end select +end function + +subroutine FAST_InitMappings(Mappings, Mods, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable, intent(out) :: Mappings(:) + type(ModDataType), intent(inout) :: Mods(:) !< Module data + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_InitMappings' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, k + integer(IntKi) :: iMap, ModIns, iModIn, iModSrc, iModDst + type(MappingType), allocatable :: MappingsTmp(:) + integer(IntKi), parameter :: MappingTypeOrder(*) = [Map_MotionMesh, Map_LoadMesh, Map_Variable, Map_Custom] + + ErrStat = ErrID_None + ErrMsg = '' + + !---------------------------------------------------------------------------- + ! Define mesh mappings between modules + !---------------------------------------------------------------------------- + + ! Define a list of all possible module mesh mappings between modules + allocate (MappingsTmp(0), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating temporary mappings", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Loop through destination modules + do iModDst = 1, size(Mods) + + ! Add mappings within module + select case (Mods(iModDst)%ID) + case (Module_ED) + call MapCustom(MappingsTmp, Custom_ED_Tower_Damping, Mods(iModDst), Mods(iModDst), & + Active=Turbine%p_FAST%CalcSteady) + + do i = 1, Turbine%ED%p(Mods(iModDst)%Ins)%NumBl + call MapCustom(MappingsTmp, Custom_ED_Blade_Damping, Mods(iModDst), Mods(iModDst), & + i=i, Active=Turbine%p_FAST%CalcSteady .and. (Turbine%p_FAST%CompElast == Module_ED)) + end do + + case (Module_BD) + call MapCustom(MappingsTmp, Custom_BD_Blade_Damping, Mods(iModDst), Mods(iModDst), & + Active=Turbine%p_FAST%CalcSteady) + end select + + ! Loop through source modules + do iModSrc = 1, size(Mods) + + ! Switch by destination module (inputs) + select case (Mods(iModDst)%ID) + case (Module_AD) + call InitMappings_AD(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + case (Module_ADsk) + call InitMappings_ADsk(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + case (Module_BD) + call InitMappings_BD(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + case (Module_ED) + call InitMappings_ED(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + case (Module_SED) + call InitMappings_SED(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + case (Module_ExtInfw) + call InitMappings_ExtInfw(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + case (Module_ExtLd) + call InitMappings_ExtLd(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + case (Module_ExtPtfm) + call InitMappings_ExtPtfm(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + case (Module_FEAM) + call InitMappings_FEAM(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + case (Module_HD) + call InitMappings_HD(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + case (Module_IceD) + call InitMappings_IceD(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + case (Module_IceF) + call InitMappings_IceF(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + case (Module_IfW) + call InitMappings_IfW(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + case (Module_MAP) + call InitMappings_MAP(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + case (Module_MD) + call InitMappings_MD(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + case (Module_Orca) + call InitMappings_Orca(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + case (Module_SD) + call InitMappings_SD(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + case (Module_SeaSt) + call InitMappings_SeaSt(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + case (Module_SrvD) + call InitMappings_SrvD(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + end select + if (Failed()) return + end do + end do + + !---------------------------------------------------------------------------- + ! Reorder mappings to be Motion, Load, Variable, Custom + !---------------------------------------------------------------------------- + + allocate(Mappings(size(MappingsTmp)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating mappings", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Loop through MappingTypeOrder and copy mesh to Mappings array if it matches the type + k = 0 + do i = 1, size(MappingTypeOrder) + do j = 1, size(MappingsTmp) + if (MappingsTmp(j)%MapType == MappingTypeOrder(i)) then + k = k + 1 + call Glue_CopyMappingType(MappingsTmp(j), Mappings(k), MESH_NEWCOPY, ErrStat2, ErrMsg2) + if (Failed()) return + end if + end do + end do + + ! Destroy temporary mappings + do i = 1, size(MappingsTmp) + call Glue_DestroyMappingType(MappingsTmp(i), ErrStat2, ErrMsg2) + if (Failed()) return + end do + + ! Loop through mappings + do iMap = 1, size(Mappings) + associate (SrcMod => Mods(Mappings(iMap)%iModSrc), & + DstMod => Mods(Mappings(iMap)%iModDst)) + + write (*, *) "Mapping: ", Mappings(iMap)%Desc + + end associate + end do + + !---------------------------------------------------------------------------- + ! Initialize mappings used to apply damping + !---------------------------------------------------------------------------- + + ! Loop through mappings + do i = 1, size(Mappings) + associate(Mapping => Mappings(i)) + + ! Select based on mapping description + select case (Mapping%Desc) + case (Custom_ED_Tower_Damping) + + ! Create temporary motion mesh as cousin of load mesh, to compute get + ! velocities at load locations for computing damping forces + call MeshCopy(SrcMesh=Turbine%ED%Input(INPUT_CURR, Mapping%DstIns)%TowerPtLoads, & + DestMesh=Mapping%TmpMotionMesh, & + CtrlCode=MESH_COUSIN, & + IOS=COMPONENT_OUTPUT, & + TranslationDisp=.true., & + TranslationVel=.true., & + ErrStat=ErrStat2, & + ErrMess=ErrMsg2) + if (Failed()) return + + ! Create motion mapping from original motion mesh to temporary motion mesh + call MeshMapCreate(Turbine%ED%y(Mapping%DstIns)%TowerLn2Mesh, Mapping%TmpMotionMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Determine mesh transfer type and save to mapping + Mapping%XfrType = MeshTransferType(Turbine%ED%y(Mapping%DstIns)%TowerLn2Mesh, Mapping%TmpMotionMesh) + + case (Custom_ED_Blade_Damping) + + ! Create temporary motion mesh as cousin of load mesh, to compute get + ! velocities at load locations for computing damping forces + call MeshCopy(SrcMesh=Turbine%ED%Input(INPUT_CURR, Mapping%DstIns)%BladePtLoads(Mapping%i), & + DestMesh=Mapping%TmpMotionMesh, & + CtrlCode=MESH_COUSIN, & + IOS=COMPONENT_OUTPUT, & + TranslationDisp=.true., & + TranslationVel=.true., & + ErrStat=ErrStat2, & + ErrMess=ErrMsg2) + if (Failed()) return + + ! Create motion mapping from original motion mesh to temporary motion mesh + call MeshMapCreate(Turbine%ED%y(Mapping%DstIns)%BladeLn2Mesh(Mapping%i), Mapping%TmpMotionMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Determine mesh transfer type and save to mapping + Mapping%XfrType = MeshTransferType(Turbine%ED%y(Mapping%DstIns)%BladeLn2Mesh(Mapping%i), Mapping%TmpMotionMesh) + + case (Custom_BD_Blade_Damping) + + ! Create temporary motion mesh as cousin of load mesh, to compute get + ! velocities at load locations for computing damping forces + call MeshCopy(SrcMesh=Turbine%BD%Input(INPUT_CURR, Mapping%DstIns)%DistrLoad, & + DestMesh=Mapping%TmpMotionMesh, & + CtrlCode=MESH_COUSIN, & + IOS=COMPONENT_OUTPUT, & + TranslationDisp=.true., & + TranslationVel=.true., & + ErrStat=ErrStat2, & + ErrMess=ErrMsg2) + if (Failed()) return + + ! Create motion mapping from original motion mesh to temporary motion mesh + call MeshMapCreate(Turbine%BD%y(Mapping%DstIns)%BldMotion, Mapping%TmpMotionMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Determine mesh transfer type and save to mapping + Mapping%XfrType = MeshTransferType(Turbine%BD%y(Mapping%DstIns)%BldMotion, Mapping%TmpMotionMesh) + + end select + end associate + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine InitMappings_AD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_AD' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + logical :: NotCompAeroMaps, CompElastED + + ErrStat = ErrID_None + ErrMsg = '' + + ! Flag is true if not computing AeroMaps + NotCompAeroMaps = .not. Turbine%p_FAST%CompAeroMaps + + ! Flag is true if CompElast == Module_ED + CompElastED = Turbine%p_FAST%CompElast == Module_ED + + ! Select based on source module identifier + select case (SrcMod%ID) + + case (Module_BD) + + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(BD_y_BldMotion), & ! BD%y(SrcMod%Ins)%BldMotion + DstMod=DstMod, DstDL=DatLoc(AD_u_BladeMotion, SrcMod%Ins), & ! AD%u%rotors(DstMod%Ins)%BladeMotion(SrcMod%Ins) + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps .or. (SrcMod%Ins == 1)) + if (Failed()) return + + case (Module_ED) + + ! Blade motion + if (Turbine%p_FAST%CompElast == Module_ED) then + do i = 1, size(Turbine%ED%y(SrcMod%Ins)%BladeLn2Mesh) + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) + DstMod=DstMod, DstDL=DatLoc(AD_u_BladeMotion, i), & ! AD%u%rotors(DstMod%Ins)%BladeMotion(i) + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=CompElastED .and. (NotCompAeroMaps .or. (i == 1))) + if (Failed()) return + end do + end if + + ! Blade root motion + do i = 1, size(Turbine%ED%y(SrcMod%Ins)%BladeRootMotion) + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(ED_y_BladeRootMotion, i), & ! ED%y%BladeRootMotion(i) + DstMod=DstMod, DstDL=DatLoc(AD_u_BladeRootMotion, i), & ! AD%u%rotors(DstMod%Ins)%BladeRootMotion(i) + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return + end do + + ! Tower motion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + DstMod=DstMod, DstDL=DatLoc(AD_u_TowerMotion), & ! AD%u%rotors(DstMod%Ins)%TowerMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return + + ! Hub motion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + DstMod=DstMod, DstDL=DatLoc(AD_u_HubMotion), & ! AD%u%rotors(DstMod%Ins)%HubMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return + + ! Nacelle motion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + DstMod=DstMod, DstDL=DatLoc(AD_u_NacelleMotion), & ! AD%u%rotors(DstMod%Ins)%NacelleMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return + + ! TailFin motion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(ED_y_TFinCMMotion), & ! ED%y%TFinCMMotion + DstMod=DstMod, DstDL=DatLoc(AD_u_TFinMotion), & ! AD%u%rotors(DstMod%Ins)%TFinMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return + + + case (Module_SED) + + ! Loop through blade root motions + do i = 1, size(Turbine%SED%y%BladeRootMotion) + + ! Blade root motion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(SED_y_BladeRootMotion, i), & ! SED%y%BladeRootMotion(i) + DstMod=DstMod, DstDL=DatLoc(AD_u_BladeRootMotion, i), & ! AD%u%rotors(DstMod%Ins)%BladeRootMotion(i) + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + ! Blade motion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(SED_y_BladeRootMotion, i), & ! SED%y%BladeRootMotion(i) + DstMod=DstMod, DstDL=DatLoc(AD_u_BladeMotion, i), & ! AD%u%rotors(DstMod%Ins)%BladeMotion(i) + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + + ! Hub motion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(SED_y_HubPtMotion), & ! SED%y%HubPtMotion + DstMod=DstMod, DstDL=DatLoc(AD_u_HubMotion), & ! AD%u%rotors(DstMod%Ins)%HubMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return + + ! Tower motion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(SED_y_TowerLn2Mesh), & ! SED%y%TowerLn2Mesh + DstMod=DstMod, DstDL=DatLoc(AD_u_TowerMotion), & ! AD%u%rotors(DstMod%Ins)%TowerMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + ! Nacelle motion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(SED_y_NacelleMotion), & ! SED%y%NacelleMotion + DstMod=DstMod, DstDL=DatLoc(AD_u_NacelleMotion), & ! AD%u%rotors(DstMod%Ins)%NacelleMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + case (Module_IfW) + + call MapVariable(Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(InflowWind_y_HWindSpeed), & + DstMod=DstMod, DstDL=DatLoc(AD_u_HWindSpeed), & + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=Turbine%p_FAST%Linearize) + if (Failed()) return + + call MapVariable(Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(InflowWind_y_PLExp), & + DstMod=DstMod, DstDL=DatLoc(AD_u_PLExp), & + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=Turbine%p_FAST%Linearize) + if (Failed()) return + + call MapVariable(Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(InflowWind_y_PropagationDir), & + DstMod=DstMod, DstDL=DatLoc(AD_u_PropagationDir), & + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=Turbine%p_FAST%Linearize) + if (Failed()) return + + case (Module_SrvD) + + call MapCustom(Mappings, Custom_SrvD_to_AD, SrcMod, DstMod) + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine InitMappings_ADsk(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_ADsk' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + + ! Select based on source module identifier + select case (SrcMod%ID) + + case (Module_ED) + + ! Hub motion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + DstMod=DstMod, DstDL=DatLoc(ADsk_u_HubMotion), & ! ADsk%u%HubMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + call MapCustom(Mappings, Custom_ED_to_ADsk, SrcMod, DstMod) + + case (Module_SED) + + ! Hub motion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(SED_y_HubPtMotion), & ! ED%y%HubPtMotion + DstMod=DstMod, DstDL=DatLoc(ADsk_u_HubMotion), & ! ADsk%u%HubMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + call MapCustom(Mappings, Custom_SED_to_ADsk, SrcMod, DstMod) + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine InitMappings_BD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_BD' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + logical :: NotCompAeroMaps, CompAeroAD + + ErrStat = ErrID_None + ErrMsg = '' + + ! Flag is true if not computing AeroMaps + NotCompAeroMaps = .not. Turbine%p_FAST%CompAeroMaps + + ! Flag is true of CompAero == Module_AD + CompAeroAD = Turbine%p_FAST%CompAero == Module_AD + + ! Select based on source module identifier + select case (SrcMod%ID) + + case (Module_AD) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(AD_y_BladeLoad, DstMod%Ins), & ! AD%y%rotors(SrcMod%Ins)%BladeLoad(DstMod%Ins) + SrcDispDL=DatLoc(AD_u_BladeMotion, DstMod%Ins), & ! AD%u%rotors(SrcMod%Ins)%BladeMotion(DstMod%Ins) + DstDL=DatLoc(BD_u_DistrLoad), & ! BD%u(DstMod%Ins)%DistrLoad + DstDispDL=DatLoc(BD_y_BldMotion), & ! BD%y(DstMod%Ins)%BldMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=CompAeroAD .and. (NotCompAeroMaps .or. (DstMod%Ins == 1))) + if (Failed()) return + + case (Module_ED) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ED_y_BladeRootMotion, DstMod%Ins), & ! ED%y%BladeRootMotion(DstMod%Ins) + DstDL=DatLoc(BD_u_RootMotion), & ! BD%u(DstMod%Ins)%RootMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return + + ! Hub motion not used + ! call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + ! SrcDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubED_y_HubPtMotion + ! DstDL=DatLoc(BD_u_HubMotion), & ! BD%Input(1, DstMod%Ins)%HubMotion + ! ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + ! Active=NotCompAeroMaps) + ! if (Failed()) return + + case (Module_ExtLd) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ExtLd_y_BladeLoad, DstMod%Ins), & ! ExtLd%y%BladeLoad(DstMod%Ins), & + SrcDispDL=DatLoc(ExtLd_u_BladeMotion, DstMod%Ins), & ! ExtLd%u%BladeMotion(DstMod%Ins) + DstDL=DatLoc(BD_u_DistrLoad), & ! BD%Input(1, DstMod%Ins)%DistrLoad + DstDispDL=DatLoc(BD_y_BldMotion), & ! BD%y(DstMod%Ins)%BldMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + case (Module_SrvD) + + do i = 1, Turbine%SrvD%p%NumBStC + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(SrvD_y_BStCLoadMesh, DstMod%Ins, i), & ! SrvD%y%BStCLoadMesh(DstMod%Ins, i), & + SrcDispDL=DatLoc(SrvD_u_BStCMotionMesh, DstMod%Ins, i), & ! SrvD%u%BStCMotionMesh(DstMod%Ins, i) + DstDL=DatLoc(BD_u_DistrLoad), & ! BD%Input(1, DstMod%Ins)%DistrLoad + DstDispDL=DatLoc(BD_y_BldMotion), & ! BD%y(DstMod%Ins)%BldMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine InitMappings_ED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_ED' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j + logical :: NotCompAeroMaps, CompAeroAD, CompElastED + + ErrStat = ErrID_None + ErrMsg = '' + + ! Flag is true if not computing AeroMaps + NotCompAeroMaps = .not. Turbine%p_FAST%CompAeroMaps + + ! Flag is true of CompAero == Module_AD + CompAeroAD = Turbine%p_FAST%CompAero == Module_AD + + ! Flag is true of CompElast == Module_ED + CompElastED = Turbine%p_FAST%CompElast == Module_ED + + ! Select based on source module identifier + select case (SrcMod%ID) + + case (Module_AD) + + ! Blade Loads + do i = 1, Turbine%ED%p(DstMod%Ins)%NumBl + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(AD_y_BladeLoad, i), & ! AD%y%rotors(SrcMod%Ins)%BladeLoad(i) + SrcDispDL=DatLoc(AD_u_BladeMotion, i), & ! AD%u%rotors(SrcMod%Ins)%BladeMotion(i) + DstDL=DatLoc(ED_u_BladePtLoads, i), & ! ED%u%BladePtLoads(i) + DstDispDL=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=CompAeroAD .and. CompElastED .and. & + (NotCompAeroMaps .or. (i == 1))) + if (Failed()) return + end do + + ! Hub Loads + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(AD_y_HubLoad), & ! AD%y%rotors(SrcMod%Ins)%HubLoad + SrcDispDL=DatLoc(AD_u_HubMotion), & ! AD%u%rotors(SrcMod%Ins)%HubMotion + DstDL=DatLoc(ED_u_HubPtLoad), & ! ED%u%HubPtLoad + DstDispDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return + + ! Nacelle Loads + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(AD_y_NacelleLoad), & ! AD%y%rotors(SrcMod%Ins)%NacelleLoad + SrcDispDL=DatLoc(AD_u_NacelleMotion), & ! AD%u%rotors(SrcMod%Ins)%NacelleMotion + DstDL=DatLoc(ED_u_NacelleLoads), & ! ED%u%NacelleLoads + DstDispDL=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return + + ! Tail Fin Loads + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(AD_y_TFinLoad), & ! AD%y%rotors(SrcMod%Ins)%TFinLoad + SrcDispDL=DatLoc(AD_u_TFinMotion), & ! AD%u%rotors(SrcMod%Ins)%TFinMotion + DstDL=DatLoc(ED_u_TFinCMLoads), & ! ED%u%TFinCMLoads + DstDispDL=DatLoc(ED_y_TFinCMMotion), & ! ED%y%TFinCMMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return + + ! Tower Loads + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(AD_y_TowerLoad), & ! AD%y%rotors(SrcMod%Ins)%TowerLoad + SrcDispDL=DatLoc(AD_u_TowerMotion), & ! AD%u%rotors(SrcMod%Ins)%TowerMotion + DstDL=DatLoc(ED_u_TowerPtLoads), & ! ED%u%TowerPtLoads + DstDispDL=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=CompAeroAD .and. NotCompAeroMaps) + if (Failed()) return + + case (Module_ADsk) + + ! Hub Loads + call MapLoadMesh(Turbine, Mappings, & + SrcMod=SrcMod, & + SrcDL=DatLoc(ADsk_y_AeroLoads), & ! ADsk%y%AeroLoads + SrcDispDL=DatLoc(ADsk_u_HubMotion), & ! ADsk%u%HubMotion + DstMod=DstMod, & + DstDL=DatLoc(ED_u_HubPtLoad), & ! ED%u%HubPtLoad + DstDispDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + case (Module_BD) + + ! Hub Loads + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(BD_y_ReactionForce), & ! BD%y(SrcMod%Ins)%ReactionForce + SrcDispDL=DatLoc(BD_u_RootMotion), & ! BD%u(SrcMod%Ins)%RootMotion + DstDL=DatLoc(ED_u_HubPtLoad), & ! ED%u%HubPtLoad + DstDispDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=NotCompAeroMaps) + if (Failed()) return + + case (Module_ExtLd) + + ! Blade loads + do i = 1, Turbine%ED%p(DstMod%Ins)%NumBl + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ExtLd_y_BladeLoad, i), & ! ExtLd%y%BladeLoad(i) + SrcDispDL=DatLoc(ExtLd_u_BladeMotion, i), & ! ExtLd%u%BladeMotion(i) + DstDL=DatLoc(ED_u_BladePtLoads, i), & ! ED%u%BladePtLoads(i) + DstDispDL=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + + ! Tower load + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ExtLd_y_TowerLoad), & ! ExtLd%y%TowerLoad + SrcDispDL=DatLoc(ExtLd_u_TowerMotion), & ! ExtLd%u%TowerMotion + DstDL=DatLoc(ED_u_TowerPtLoads), & ! ED%u%TowerPtLoads + DstDispDL=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + case (Module_ExtPtfm) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ExtPtfm_y_PtfmMesh), & ! ExtPtfm%y%PtfmMesh + SrcDispDL=DatLoc(ExtPtfm_u_PtfmMesh), & ! ExtPtfm%u%PtfmMesh + DstDL=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + case (Module_FEAM) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(FEAM_y_PtFairleadLoad), & ! FEAM%y%PtFairleadLoad, & + SrcDispDL=DatLoc(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement + DstDL=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + case (Module_HD) + + ! Platform loads (SubDyn not active) + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(HydroDyn_y_Morison_Mesh), & ! HD%y%Morison%Mesh + SrcDispDL=DatLoc(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh + DstDL=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + Active=Turbine%p_FAST%CompSub == Module_None, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + ! Platform loads (SubDyn not active) + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(HydroDyn_y_WAMITMesh), & ! HD%y%WAMITMesh + SrcDispDL=DatLoc(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh + DstDL=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + Active=Turbine%p_FAST%CompSub == Module_None, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + case (Module_IceD) + + ! Platform loads (SubDyn not active) + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(IceD_y_PointMesh), & ! IceD%y%PointMesh + SrcDispDL=DatLoc(IceD_u_PointMesh), & ! IceD%u%PointMesh + DstDL=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + case (Module_IceF) + + ! Platform loads (SubDyn not active) + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(IceFloe_y_iceMesh), & ! IceFloe%y%iceMesh + SrcDispDL=DatLoc(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh + DstDL=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + case (Module_MAP) + + ! Platform loads (SubDyn not active) + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(MAP_y_ptFairleadLoad), & ! MAP%y%PtFairleadLoad + SrcDispDL=DatLoc(MAP_u_PtFairDisplacement), & ! MAP%u%PtFairDisplacement + DstDL=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + case (Module_MD) + + ! Platform loads (SubDyn not active) + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(MD_y_CoupledLoads, 1), & ! MD%y%CoupledLoads(1) + SrcDispDL=DatLoc(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) + DstDL=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + case (Module_Orca) + + ! Platform loads (SubDyn not active) + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(Orca_y_PtfmMesh), & ! Orca%y%PtfmMesh + SrcDispDL=DatLoc(Orca_u_PtfmMesh), & ! Orca%u%PtfmMesh + DstDL=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + case (Module_SD) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(SD_y_Y1Mesh), & ! SD%y%Y1mesh, & + SrcDispDL=DatLoc(SD_u_TPMesh), & ! SD%u%TPMesh + DstDL=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + case (Module_SrvD) + + call MapVariable(Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(SrvD_y_BlPitchCom), & + DstMod=DstMod, DstDL=DatLoc(ED_u_BlPitchCom), & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + + call MapVariable(Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(SrvD_y_YawMom), & + DstMod=DstMod, DstDL=DatLoc(ED_u_YawMom), & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + + call MapVariable(Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(SrvD_y_GenTrq), & + DstMod=DstMod, DstDL=DatLoc(ED_u_GenTrq), & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + + call MapCustom(Mappings, Custom_SrvD_to_ED, SrcMod, DstMod) + + ! Blade Structural Controller (if ElastoDyn is used for blades) + do j = 1, Turbine%SrvD%p%NumBStC + do i = 1, Turbine%ED%p(DstMod%Ins)%NumBl + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(SrvD_y_BStCLoadMesh, i, j), & ! SrvD%y%BStCLoadMesh(i, j), & + SrcDispDL=DatLoc(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) + DstDL=DatLoc(ED_u_BladePtLoads, i), & ! ED%u%BladePtLoads(i) + DstDispDL=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) + Active=Turbine%p_FAST%CompElast == Module_ED, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + end do + + ! Nacelle Structural Controller + do j = 1, Turbine%SrvD%p%NumNStC + call MapLoadMesh(Turbine, Mappings, & + SrcMod=SrcMod, & + SrcDL=DatLoc(SrvD_y_NStCLoadMesh, j), & ! SrvD%y%NStCLoadMesh(j), & + SrcDispDL=DatLoc(SrvD_u_NStCMotionMesh, j), & ! SrvD%u%NStCMotionMesh(j) + DstMod=DstMod, & + DstDL=DatLoc(ED_u_NacelleLoads), & ! ED%u%NacelleLoads + DstDispDL=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + + ! Tower Structural Controller + do j = 1, Turbine%SrvD%p%NumTStC + call MapLoadMesh(Turbine, Mappings, & + SrcMod=SrcMod, & + SrcDL=DatLoc(SrvD_y_TStCLoadMesh, j), & ! SrvD%y%TStCLoadMesh(j), & + SrcDispDL=DatLoc(SrvD_u_TStCMotionMesh, j), & ! SrvD%u%TStCMotionMesh(j) + DstMod=DstMod, & + DstDL=DatLoc(ED_u_TowerPtLoads), & ! ED%u%TowerLoads + DstDispDL=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + + ! Substructure Structural Controller + do j = 1, Turbine%SrvD%p%NumSStC + call MapLoadMesh(Turbine, Mappings, & + SrcMod=SrcMod, & + SrcDL=DatLoc(SrvD_y_SStCLoadMesh, j), & ! SrvD%y%SStCLoadMesh(j), & + SrcDispDL=DatLoc(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) + DstMod=DstMod, & + DstDL=DatLoc(ED_u_PlatformPtMesh), & ! ED%u%PlatformPtMesh + DstDispDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine InitMappings_SED(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_SED' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j + + ErrStat = ErrID_None + ErrMsg = '' + + ! Select based on source module identifier + select case (SrcMod%ID) + + case (Module_AD) + + ! Blade Loads + do i = 1, size(Turbine%AD%y%rotors(SrcMod%Ins)%BladeLoad) + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(AD_y_BladeLoad, i), & ! AD%y%rotors(SrcMod%Ins)%BladeLoad(i) + SrcDispDL=DatLoc(AD_u_BladeMotion, i), & ! AD%u%rotors(SrcMod%Ins)%BladeMotion(i) + DstDL=DatLoc(SED_u_HubPtLoad), & ! SED%u%HubPtLoad + DstDispDL=DatLoc(SED_y_HubPtMotion), & ! SED%y%HubPtMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + + case (Module_ADsk) + + ! Hub Loads + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ADsk_y_AeroLoads), & ! ADsk%y%AeroLoads + SrcDispDL=DatLoc(ADsk_u_HubMotion), & ! ADsk%u%HubMotion + DstDL=DatLoc(SED_u_HubPtLoad), & ! SED%u%HubPtLoad + DstDispDL=DatLoc(SED_y_HubPtMotion), & ! SED%y%HubPtMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + case (Module_SrvD) + + call MapCustom(Mappings, Custom_SrvD_to_SED, SrcMod, DstMod) + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine InitMappings_ExtInfw(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_ExtInfw' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine InitMappings_ExtLd(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_ExtLd' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, k + logical :: CompElastED + + ErrStat = ErrID_None + ErrMsg = '' + + ! Flag is true if CompElast == Module_ED + CompElastED = Turbine%p_FAST%CompElast == Module_ED + + select case (SrcMod%ID) + case (Module_AD) + + ! Blade Loads + do i = 1, size(Turbine%AD%y%rotors(SrcMod%Ins)%BladeLoad) + call MapLoadMesh(Turbine, Mappings, & + SrcMod=SrcMod, & + SrcDL=DatLoc(AD_y_BladeLoad, i), & ! AD%y%rotors(SrcMod%Ins)%BladeLoad(i) + SrcDispDL=DatLoc(AD_u_BladeMotion, i), & ! AD%u%rotors(SrcMod%Ins)%BladeMotion(i) + DstMod=DstMod, & + DstDL=DatLoc(ExtLd_u_BladeLoadAD, i), & ! ExtLd%u%BladeLoadAD(i) + DstDispDL=DatLoc(ExtLd_u_BladeMotion, i), & ! ExtLd%u%BladeMotion(i) + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + end do + + ! Tower Loads + call MapLoadMesh(Turbine, Mappings, & + SrcMod=SrcMod, & + SrcDL=DatLoc(AD_y_TowerLoad), & ! AD%y%rotors(SrcMod%Ins)%TowerLoad + SrcDispDL=DatLoc(AD_u_TowerMotion), & ! AD%u%rotors(SrcMod%Ins)%TowerMotion + DstMod=DstMod, & + DstDL=DatLoc(ExtLd_u_TowerLoadAD), & ! ExtLd%u%TowerLoadAD + DstDispDL=DatLoc(ExtLd_u_TowerMotion), & ! ExtLd%u%TowerMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + + case (Module_BD) + + ! Blade motion + call MapMotionMesh(Turbine, Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(BD_y_BldMotion), & ! BD%y(SrcMod%Ins)%BldMotion + DstMod=DstMod, DstDL=DatLoc(ExtLd_u_BladeMotion, SrcMod%Ins), & ! ExtLd%u%BladeMotion(SrcMod%Ins) + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if(Failed()) return + + case (Module_ED) + + call MapCustom(Mappings, Custom_ED_to_ExtLd, SrcMod, DstMod) + + ! Blade motion + do i = 1, Turbine%ED%p(SrcMod%Ins)%NumBl + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) + DstDL=DatLoc(ExtLd_u_BladeMotion, i), & ! ExtLd%u%BladeMotion(i) + Active=CompElastED, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if(Failed()) return + end do + + ! Blade root motion + do i = 1, Turbine%ED%p(SrcMod%Ins)%NumBl + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ED_y_BladeRootMotion, i), & ! ED%y%BladeRootMotion(i) + DstDL=DatLoc(ExtLd_u_BladeRootMotion, i), & ! ExtLd%u%BladeRootMotion(i) + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if(Failed()) return + end do + + ! Tower motion + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerLn2Mesh + DstDL=DatLoc(ExtLd_u_TowerMotion), & ! ExtLd%u%TowerMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if(Failed()) return + + ! Hub motion + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ED_y_HubPtMotion), & ! ED%y%HubPtMotion + DstDL=DatLoc(ExtLd_u_HubMotion), & ! ExtLd%u%HubMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if(Failed()) return + + ! Nacelle motion + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + DstDL=DatLoc(ExtLd_u_NacelleMotion), & ! ExtLd%u%NacelleMotion + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if(Failed()) return + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine InitMappings_ExtPtfm(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_ExtPtfm' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + + case (Module_ED) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(ExtPtfm_u_PtfmMesh), & ! ExtPtfm%u%PtfmMesh + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine InitMappings_FEAM(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_FEAM' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + + case (Module_ED) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_SD) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(SD_y_Y3Mesh), & ! SD%y%y3Mesh + DstDL=DatLoc(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + end select + + select case (SrcMod%ID) + case (Module_ED) + + if (Turbine%p_FAST%CompSub /= Module_SD) then + ! CALL MeshMapCreate( SubstructureMotion, FEAM%u%PtFairleadDisplacement, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) + end if + + case (Module_SD) + + ! CALL MeshMapCreate( SubstructureMotion, FEAM%u%PtFairleadDisplacement, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine InitMappings_HD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_HD' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + + case (Module_ED) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(HydroDyn_u_PRPMesh), & ! HD%u%PRPMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=Turbine%p_FAST%CompSub /= Module_SD); if(Failed()) return + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=Turbine%p_FAST%CompSub /= Module_SD); if(Failed()) return + + case (Module_SeaSt) + + call MapVariable(Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(SeaSt_y_WaveElev0), & + DstMod=DstMod, DstDL=DatLoc(HydroDyn_u_WaveElev0), & + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=Turbine%p_FAST%Linearize); if (Failed()) return + + case (Module_SD) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(SD_y_Y2Mesh), & ! SD%y%Y2Mesh + DstDL=DatLoc(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(SD_y_Y2Mesh), & ! SD%y%Y2Mesh + DstDL=DatLoc(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine InitMappings_IceD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_IceD' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + case (Module_ED) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(IceD_u_PointMesh), & ! IceD%u%PointMesh + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_SD) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(SD_y_Y3Mesh), & ! SD%y%y3Mesh + DstDL=DatLoc(IceD_u_PointMesh), & ! IceD%u%PointMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine InitMappings_IceF(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_IceF' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + case (Module_ED) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_SD) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(SD_y_Y3Mesh), & ! SD%y%y3Mesh + DstDL=DatLoc(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine InitMappings_IfW(Mappings, SrcMod, DstMod, T, ErrStat, ErrMsg) + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_IfW' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + case (Module_SED) + call MapCustom(Mappings, Custom_SED_to_IfW, SrcMod, DstMod) + case (Module_ED) + call MapCustom(Mappings, Custom_ED_to_IfW, SrcMod, DstMod) + case (Module_SrvD) + call MapCustom(Mappings, Custom_SrvD_to_IfW, SrcMod, DstMod) + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine InitMappings_MAP(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_MAP' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + case (Module_ED) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(MAP_u_PtFairDisplacement), & ! MAPp%u%PtFairDisplacement + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_SD) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(SD_y_Y3Mesh), & ! SD%y%y3Mesh + DstDL=DatLoc(MAP_u_PtFairDisplacement), & ! MAPp%u%PtFairDisplacement + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine InitMappings_MD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_MD' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + + case (Module_ED) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_SD) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(SD_y_Y3Mesh), & ! SD%y%y3Mesh + DstDL=DatLoc(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_SrvD) + + call MapCustom(Mappings, Custom_SrvD_to_MD, SrcMod, DstMod) + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine InitMappings_Orca(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_Orca' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + case (Module_ED) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(Orca_u_PtfmMesh), & ! Orca%u%PtfmMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine InitMappings_SD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_SD' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + + case (Module_ED) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(SD_u_TPMesh), & ! SD%u%TPMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_FEAM) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(FEAM_y_PtFairleadLoad), & ! FEAM%y%PtFairleadLoad, & + SrcDispDL=DatLoc(FEAM_u_PtFairleadDisplacement), & ! FEAM%u%PtFairleadDisplacement + DstDL=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispDL=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_HD) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(HydroDyn_y_Morison_Mesh), & ! HD%y%Morison%Mesh + SrcDispDL=DatLoc(HydroDyn_u_Morison_Mesh), & ! HD%u%Morison%Mesh + DstDL=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispDL=DatLoc(SD_y_y2Mesh), & ! SD%y%y2Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(HydroDyn_y_WAMITMesh), & ! HD%y%WAMITMesh + SrcDispDL=DatLoc(HydroDyn_u_WAMITMesh), & ! HD%u%WAMITMesh + DstDL=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispDL=DatLoc(SD_y_y2Mesh), & ! SD%y%y2Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_IceD) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(IceD_y_PointMesh), & ! IceD%y%PointMesh + SrcDispDL=DatLoc(IceD_u_PointMesh), & ! IceD%u%PointMesh + DstDL=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispDL=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_IceF) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(IceFloe_y_iceMesh), & ! IceFloe%y%iceMesh + SrcDispDL=DatLoc(IceFloe_u_iceMesh), & ! IceFloe%u%iceMesh + DstDL=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispDL=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_MAP) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(MAP_y_ptFairleadLoad), & ! MAP%y%PtFairleadLoad + SrcDispDL=DatLoc(MAP_u_PtFairDisplacement), & ! MAP%u%PtFairDisplacement + DstDL=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispDL=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_MD) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(MD_y_CoupledLoads, 1), & ! MD%y%CoupledLoads(1) + SrcDispDL=DatLoc(MD_u_CoupledKinematics, 1), & ! MD%u%CoupledKinematics(1) + DstDL=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispDL=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + case (Module_SrvD) + + call MapCustom(Mappings, Custom_SrvD_to_SD, SrcMod, DstMod) + + ! Substructure Structural Controller + do j = 1, Turbine%SrvD%p%NumSStC + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(SrvD_y_SStCLoadMesh, j), & ! SrvD%y%SStCLoadMesh(j), & + SrcDispDL=DatLoc(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) + DstDL=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispDL=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine InitMappings_SeaSt(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_SeaSt' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + + ! No inputs to SeaState currently + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_BD' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + + case (Module_BD) + + call MapCustom(Mappings, Custom_BD_to_SrvD, SrcMod, DstMod) + + ! Blade Structural Controller + do i = 1, Turbine%SrvD%p%NumBStC + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(BD_y_BldMotion), & ! BD%y%BldMotion + DstDL=DatLoc(SrvD_u_BStCMotionMesh, DstMod%Ins, i), & ! SrvD%u%BStCMotionMesh(i, j) + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do + + case (Module_ED) + + call MapCustom(Mappings, Custom_ED_to_SrvD, SrcMod, DstMod) + + call MapVariable(Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(ED_y_Yaw), & + DstMod=DstMod, DstDL=DatLoc(SrvD_u_Yaw), & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + + call MapVariable(Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(ED_y_YawRate), & + DstMod=DstMod, DstDL=DatLoc(SrvD_u_YawRate), & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + + call MapVariable(Mappings, & + SrcMod=SrcMod, SrcDL=DatLoc(ED_y_HSS_Spd), & + DstMod=DstMod, DstDL=DatLoc(SrvD_u_HSS_Spd), & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + + ! Nacelle Structural Controller + do j = 1, Turbine%SrvD%p%NumNStC + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ED_y_NacelleMotion), & ! ED%y%NacelleMotion + DstDL=DatLoc(SrvD_u_NStCMotionMesh, j), & ! SrvD%u%NStCMotionMesh(j) + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do + + ! Tower Structural Controller + do j = 1, Turbine%SrvD%p%NumTStC + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ED_y_TowerLn2Mesh), & ! ED%y%TowerMotion + DstDL=DatLoc(SrvD_u_TStCMotionMesh, j), & ! SrvD%u%TStCMotionMesh(j) + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do + + ! Blade Structural Controller (if ElastoDyn blades) + do j = 1, Turbine%SrvD%p%NumBStC + do i = 1, Turbine%ED%p(SrcMod%Ins)%NumBl + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ED_y_BladeLn2Mesh, i), & ! ED%y%BladeLn2Mesh(i) + DstDL=DatLoc(SrvD_u_BStCMotionMesh, i, j), & ! SrvD%u%BStCMotionMesh(i, j) + Active=Turbine%p_FAST%CompElast == Module_ED, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do + end do + + ! Substructure Structural Controller (if not using SubDyn) + do j = 1, Turbine%SrvD%p%NumSStC + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(ED_y_PlatformPtMesh), & ! ED%y%PlatformPtMesh + DstDL=DatLoc(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) + Active=Turbine%p_FAST%CompSub /= Module_SD, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do + + case (Module_SED) + + call MapCustom(Mappings, Custom_SED_to_SrvD, SrcMod=SrcMod, DstMod=DstMod) + + case (Module_IfW) + + call MapCustom(Mappings, Custom_IfW_to_SrvD, SrcMod=SrcMod, DstMod=DstMod) + + case (Module_SD) + + ! Substructure Structural Controller + do j = 1, Turbine%SrvD%p%NumSStC + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh + DstDL=DatLoc(SrvD_u_SStCMotionMesh, j), & ! SrvD%u%SStCMotionMesh(j) + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + end do + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine MapLoadMesh(Turbine, Mappings, SrcMod, SrcDL, SrcDispDL, & + DstMod, DstDL, DstDispDL, ErrStat, ErrMsg, Active) + type(FAST_TurbineType), target :: Turbine + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(DatLoc), intent(in) :: SrcDL, DstDL + type(DatLoc), intent(in) :: SrcDispDL, DstDispDL + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + logical, optional, intent(in) :: Active + + character(*), parameter :: RoutineName = 'MapLoadMesh' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + type(MappingType) :: Mapping + type(MeshType), pointer :: SrcMesh, SrcDispMesh + type(MeshType), pointer :: DstMesh, DstDispMesh + type(MeshType) :: DstMotionMesh + + ErrStat = ErrID_None + ErrMsg = '' + + ! If active argument is set to false, return + if (present(Active)) then + if (.not. Active) return + end if + + ! Get mesh pointers (DstDispMesh may be found in Input for some modules: ExtLd) + call FAST_OutputMeshPointer(SrcMod, Turbine, SrcDL, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(SrcMod, Turbine, SrcDispDL, SrcDispMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(DstMod, Turbine, DstDL, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_OutputMeshPointer(DstMod, Turbine, DstDispDL, DstDispMesh, ErrStat2, ErrMsg2) + if (ErrStat2 == ErrID_Fatal) call FAST_InputMeshPointer(DstMod, Turbine, DstDispDL, DstDispMesh, INPUT_CURR, ErrStat2, ErrMsg2) + if (Failed()) return + + ! If any meshes aren't committed, return + if (.not. (SrcMesh%committed .and. DstMesh%committed .and. SrcDispMesh%committed .and. DstDispMesh%committed)) return + + ! Check that all meshes in mapping have nonzero identifiers + if (SrcMesh%ID == 0) then + call SetErrStat(ErrID_Fatal, 'SrcMesh "'//trim(FAST_OutputFieldName(SrcMod, SrcDL))//'" not in module variables', & + ErrStat, ErrMsg, RoutineName) + return + else if (SrcDispMesh%ID == 0) then + call SetErrStat(ErrID_Fatal, 'SrcDispMesh "'//trim(FAST_InputFieldName(SrcMod, SrcDispDL))//'" not in module variables', & + ErrStat, ErrMsg, RoutineName) + return + else if (DstMesh%ID == 0) then + call SetErrStat(ErrID_Fatal, 'DstMesh "'//trim(FAST_InputFieldName(DstMod, DstDL))//'" not in module variables', & + ErrStat, ErrMsg, RoutineName) + return + else if (DstDispMesh%ID == 0) then + call SetErrStat(ErrID_Fatal, 'DstDispMesh "'//trim(FAST_OutputFieldName(DstMod, DstDispDL))//'" not in module variables', & + ErrStat, ErrMsg, RoutineName) + return + end if + + ! Create mapping description + Mapping%Desc = trim(FAST_OutputFieldName(SrcMod, SrcDL))//" -> "// & + trim(FAST_InputFieldName(DstMod, DstDL))// & + " ["//trim(FAST_InputFieldName(SrcMod, SrcDispDL))// & + " @ "//trim(FAST_OutputFieldName(DstMod, DstDispDL))//"]" + + ! Initialize mapping structure + Mapping%MapType = Map_LoadMesh + Mapping%iModSrc = SrcMod%iMod + Mapping%SrcModID = SrcMod%ID + Mapping%SrcIns = SrcMod%Ins + Mapping%iModDst = DstMod%iMod + Mapping%DstModID = DstMod%ID + Mapping%DstIns = DstMod%Ins + Mapping%SrcDL = SrcDL + Mapping%SrcDispDL = SrcDispDL + Mapping%DstDL = DstDL + Mapping%DstDispDL = DstDispDL + Mapping%XfrType = MeshTransferType(SrcMesh, DstMesh) + + ! Create mesh mapping + call MeshMapCreate(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return + + ! Create a copy of destination mesh in mapping for load summation + call MeshCopy(DstMesh, Mapping%TmpLoadMesh, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + + ! Set VF_Mapping on variables in this mapping + call SetMapVarFlags(Mapping, SrcMod, DstMod) + + ! If the destination displacement mesh is not a sibling of the load mesh + Mapping%DstUsesSibling = IsSiblingMesh(DstMesh, DstDispMesh) + if (.not. Mapping%DstUsesSibling) then + + ! Indicate non-sibling destination displacement mesh in description + Mapping%Desc = trim(Mapping%Desc)//'*' + + ! Create temporary motion mesh as cousin of load mesh, this will be used for an intermediate transfer + ! of the destination motion to the destination load locations + call MeshCopy(SrcMesh=DstMesh, & + DestMesh=Mapping%TmpMotionMesh, & + CtrlCode=MESH_COUSIN, & + IOS=COMPONENT_OUTPUT, & + TranslationDisp=.true., & + Orientation=.true., & + RotationVel=.true., & + TranslationVel=.true., & + RotationAcc=.true., & + TranslationAcc=.true., & + ErrStat=ErrStat2, & + ErrMess=ErrMsg2) + if (Failed()) return + + ! Determine transfer/linearization type for this auxiliary transfer + Mapping%XfrTypeAux = MeshTransferType(DstDispMesh, Mapping%TmpMotionMesh) + + ! Create motion mapping from destination displacement to temporary motion mesh + call MeshMapCreate(DstDispMesh, Mapping%TmpMotionMesh, Mapping%MeshMapAux, ErrStat2, ErrMsg2); if (Failed()) return + + end if + + ! Add mapping to array of mappings + Mappings = [Mappings, Mapping] + +contains + logical function Failed() + Failed = ErrStat2 >= AbortErrLev + if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end function + + ! IsSiblingMesh returns true if MeshB is a sibling of MeshA + ! (can't just check pointers as they won't match after restart, + ! also there can only be one sibling mesh so doesn't work for cousins) + pure logical function IsSiblingMesh(MeshA, MeshB) + type(MeshType), intent(in) :: MeshA, MeshB + integer(IntKi) :: i, j + IsSiblingMesh = .false. + if (MeshA%Nnodes /= MeshB%Nnodes) return + if (any(MeshA%Position /= MeshB%Position)) return + if (any(MeshA%RefOrientation /= MeshB%RefOrientation)) return + do i = 1, NELEMKINDS + if (MeshA%ElemTable(i)%nelem /= MeshB%ElemTable(i)%nelem) return + if (MeshA%ElemTable(i)%XElement /= MeshB%ElemTable(i)%XElement) return + do j = 1, MeshA%ElemTable(i)%nelem + if (any(MeshA%ElemTable(i)%Elements(j)%ElemNodes /= MeshB%ElemTable(i)%Elements(j)%ElemNodes)) return + end do + end do + IsSiblingMesh = .true. + end function +end subroutine + +subroutine MapMotionMesh(Turbine, Mappings, SrcMod, SrcDL, DstMod, DstDL, ErrStat, ErrMsg, Active) + type(FAST_TurbineType), target :: Turbine + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(DatLoc), intent(in) :: SrcDL, DstDL + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + logical, optional, intent(in) :: Active + + character(*), parameter :: RoutineName = 'MapMotionMesh' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + type(MappingType) :: Mapping + type(MeshType), pointer :: SrcMesh, DstMesh + + ErrStat = ErrID_None + ErrMsg = '' + + ! If active argument is set to false, return + if (present(Active)) then + if (.not. Active) return + end if + + ! Get mesh pointers + call FAST_OutputMeshPointer(SrcMod, Turbine, SrcDL, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(DstMod, Turbine, DstDL, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return + + ! If source or destination meshes aren't commited, return + if (.not. (SrcMesh%committed .and. DstMesh%committed)) return + + ! Check that all meshes in mapping have nonzero identifiers + if (SrcMesh%ID == 0) then + call SetErrStat(ErrID_Fatal, 'SrcMesh "'//trim(FAST_OutputFieldName(SrcMod, SrcDL))//'" not in module variables', & + ErrStat, ErrMsg, RoutineName) + return + else if (DstMesh%ID == 0) then + call SetErrStat(ErrID_Fatal, 'DstMesh "'//trim(FAST_InputFieldName(DstMod, DstDL))//'" not in module variables', & + ErrStat, ErrMsg, RoutineName) + return + end if + + ! Create mapping description + Mapping%Desc = trim(FAST_OutputFieldName(SrcMod, SrcDL))//" -> "// & + trim(FAST_InputFieldName(DstMod, DstDL)) + + ! Initialize mapping structure + Mapping%MapType = Map_MotionMesh + Mapping%iModSrc = SrcMod%iMod + Mapping%SrcModID = SrcMod%ID + Mapping%SrcIns = SrcMod%Ins + Mapping%iModDst = DstMod%iMod + Mapping%DstModID = DstMod%ID + Mapping%DstIns = DstMod%Ins + Mapping%SrcDL = SrcDL + Mapping%DstDL = DstDL + Mapping%XfrType = MeshTransferType(SrcMesh, DstMesh) + + ! Set VF_Mapping on variables in this mapping + call SetMapVarFlags(Mapping, SrcMod, DstMod) + + ! Create mesh mapping + call MeshMapCreate(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return + + ! Add mapping to array of mappings + Mappings = [Mappings, Mapping] + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine MapVariable(Maps, SrcMod, SrcDL, DstMod, DstDL, ErrStat, ErrMsg, Active) + type(MappingType), allocatable :: Maps(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(DatLoc), intent(in) :: SrcDL, DstDL + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + logical, optional, intent(in) :: Active + type(MappingType) :: Mapping + integer(IntKi) :: iVarSrc, iVarDst + + ErrStat = ErrID_None + ErrMsg = '' + + if (present(Active)) then + if (.not. Active) return + end if + + ! Get source and destination variable indices + iVarSrc = MV_FindVarDatLoc(SrcMod%Vars%y, SrcDL) + iVarDst = MV_FindVarDatLoc(DstMod%Vars%u, DstDL) + + ! If either variable index is zero, return error + if (iVarSrc == 0) then + ErrStat = ErrID_Fatal + ErrMsg = "Source variable "//trim(Num2LStr(SrcDL%Num))//" in module '"//trim(SrcMod%Abbr)//"' is not active" + return + else if (iVarDst == 0) then + ErrStat = ErrID_Fatal + ErrMsg = "Destination variable "//trim(Num2LStr(DstDL%Num))//" in module '"//trim(DstMod%Abbr)//"' is not active" + return + end if + + ! Create mapping description + Mapping%Desc = trim(FAST_OutputFieldName(SrcMod, SrcDL))//" -> "// & + trim(FAST_InputFieldName(DstMod, DstDL)) + + ! Verify that variables have compatible sizes + ! If source variable has size 1, it can be mapped to multiple destination variables + if ((SrcMod%Vars%y(iVarSrc)%Num > 1) .and. & + (SrcMod%Vars%y(iVarSrc)%Num /= DstMod%Vars%u(iVarDst)%Num)) then + ErrStat = ErrID_Fatal + ErrMsg = "Variables in mapping '"//trim(Mapping%Desc)//"' have incompatible sizes" + return + end if + + ! Initialize mapping structure + Mapping%MapType = Map_Variable + Mapping%iModSrc = SrcMod%iMod + Mapping%iModDst = DstMod%iMod + Mapping%SrcModID = SrcMod%ID + Mapping%DstModID = DstMod%ID + Mapping%SrcIns = SrcMod%Ins + Mapping%DstIns = DstMod%Ins + Mapping%SrcDL = SrcDL + Mapping%DstDL = DstDL + + ! Set VF_Mapping on variables in this mapping + call SetMapVarFlags(Mapping, SrcMod, DstMod) + + ! Copy source and destination variables and modify for packing/unpacking + Mapping%SrcVar = SrcMod%Vars%y(iVarSrc) + Mapping%DstVar = DstMod%Vars%u(iVarDst) + Mapping%SrcVar%iLoc = [1, Mapping%SrcVar%Num] + Mapping%DstVar%iLoc = [1, Mapping%DstVar%Num] + + ! Allocate variable data storage + call AllocAry(Mapping%VarData, max(Mapping%SrcVar%Num, Mapping%DstVar%Num), "VarData", ErrStat, ErrMsg) + + Maps = [Maps, Mapping] +end subroutine + +!> MapCustom creates a custom mapping that is not included in linearization. +!! Each custom mapping needs an entry in FAST_InputSolve to actually perform the transfer. +subroutine MapCustom(Maps, Desc, SrcMod, DstMod, i, Active) + type(MappingType), allocatable :: Maps(:) + character(*), intent(in) :: Desc + type(ModDataType), intent(inout) :: SrcMod, DstMod + integer(IntKi), optional, intent(in) :: i + logical, optional, intent(in) :: Active + type(MappingType) :: Mapping + + if (present(Active)) then + if (.not. Active) return + end if + + ! Initialize mapping structure + Mapping%Desc = Desc + Mapping%MapType = Map_Custom + Mapping%iModSrc = SrcMod%iMod + Mapping%iModDst = DstMod%iMod + Mapping%SrcModID = SrcMod%ID + Mapping%DstModID = DstMod%ID + Mapping%SrcIns = SrcMod%Ins + Mapping%DstIns = DstMod%Ins + if (present(i)) Mapping%i = i + + Maps = [Maps, Mapping] +end subroutine + +subroutine SetMapVarFlags(Mapping, SrcMod, DstMod) + type(MappingType), intent(in) :: Mapping + type(ModDataType), intent(inout) :: SrcMod, DstMod + integer(IntKi) :: i + + ! Set mapping flag on source variables + do i = 1, size(SrcMod%Vars%y) + associate (Var => SrcMod%Vars%y(i)) + if (MV_EqualDL(Mapping%SrcDL, Var%DL)) call MV_SetFlags(Var, VF_Mapping) + end associate + end do + + ! Set mapping flag on destination variables + do i = 1, size(DstMod%Vars%u) + associate (Var => DstMod%Vars%u(i)) + if (MV_EqualDL(Mapping%DstDL, Var%DL)) call MV_SetFlags(Var, VF_Mapping) + end associate + end do + + ! If this a load mesh mapping + if (Mapping%MapType == Map_LoadMesh) then + + ! Set mapping flag on source displacement mesh variables + do i = 1, size(SrcMod%Vars%u) + associate (Var => SrcMod%Vars%u(i)) + if (MV_EqualDL(Mapping%SrcDispDL, Var%DL)) then + select case (Var%Field) + case (FieldTransDisp) + call MV_SetFlags(Var, VF_Mapping) + end select + end if + end associate + end do + + ! Set mapping flag on destination displacement mesh variables + do i = 1, size(DstMod%Vars%y) + associate (Var => DstMod%Vars%y(i)) + if (MV_EqualDL(Mapping%DstDispDL, Var%DL)) then + select case (Var%Field) + case (FieldTransDisp, FieldOrientation) + call MV_SetFlags(Var, VF_Mapping) + end select + end if + end associate + end do + end if + +end subroutine + +function MeshTransferType(SrcMesh, DstMesh) result(XfrType) + type(MeshType), intent(in) :: SrcMesh, DstMesh + integer(IntKi) :: XfrType + if ((SrcMesh%ElemTable(ELEMENT_POINT)%nelem > 0) .and. (DstMesh%ElemTable(ELEMENT_POINT)%nelem > 0)) then + XfrType = Xfr_Point_to_Point + else if ((SrcMesh%ElemTable(ELEMENT_POINT)%nelem > 0) .and. (DstMesh%ElemTable(ELEMENT_LINE2)%nelem > 0)) then + XfrType = Xfr_Point_to_Line2 + else if ((SrcMesh%ElemTable(ELEMENT_LINE2)%nelem > 0) .and. (DstMesh%ElemTable(ELEMENT_POINT)%nelem > 0)) then + XfrType = Xfr_Line2_to_Point + else if ((SrcMesh%ElemTable(ELEMENT_LINE2)%nelem > 0) .and. (DstMesh%ElemTable(ELEMENT_LINE2)%nelem > 0)) then + XfrType = Xfr_Line2_to_Line2 + else + XfrType = Xfr_Invalid + end if +end function + +subroutine FAST_LinearizeMappings(ModGlue, Mappings, Turbine, ErrStat, ErrMsg) + type(ModGlueType), intent(inout) :: ModGlue !< Glue module data + type(MappingType), intent(inout) :: Mappings(:) !< Variable mappings + type(FAST_TurbineType), target, intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_LinearizeMappings' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: iGluSrc(2), iGluDst(2), nLocSrc, nLocDst + integer(IntKi) :: i, j, k + type(MeshType), pointer :: SrcMesh, DstMesh + type(MeshType), pointer :: SrcDispMesh, DstDispMesh + + ErrStat = ErrID_None + ErrMsg = '' + + ! Exit function if dUdy and dUdu aren't allocated + if (.not. (allocated(ModGlue%Lin%dUdy) .and. allocated(ModGlue%Lin%dUdu))) return + + ! Initialize dUdy to zero + ModGlue%Lin%dUdy = 0.0_R8Ki + + ! Initialize dUdu to identity matrix + call Eye2D(ModGlue%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return + + ! Loop through variable maps + do i = 1, size(ModGlue%VarMaps) + + associate (ModMap => ModGlue%VarMaps(i), & + Mapping => Mappings(ModGlue%VarMaps(i)%iMapping), & + ModSrc => ModGlue%ModData(ModGlue%VarMaps(i)%iModSrc), & + ModDst => ModGlue%ModData(ModGlue%VarMaps(i)%iModDst)) + + ! Select based on type of mapping + select case (Mapping%MapType) + + case (Map_Variable) + + ! Get source and destination indices, skip if no variable index for either + if (ModMap%iVarSrc(1) == 0 .or. ModMap%iVarDst(1) == 0) cycle + iGluSrc = ModSrc%Vars%y(ModMap%iVarSrc(1))%iGlu + iGluDst = ModDst%Vars%u(ModMap%iVarDst(1))%iGlu + + ! Get number of source and destination locations + nLocSrc = iGluSrc(2) - iGluSrc(1) + 1 + nLocDst = iGluDst(2) - iGluDst(1) + 1 + + ! If source has multiple locations, destination must have same number, connect 1-to-1 + ! MapVariable checks that variables have same number if nLocSrc > 1 + if (nLocSrc > 1) then + do k = 0, nLocDst - 1 + ModGlue%Lin%dUdy(iGluDst(1) + k, iGluSrc(1) + k) = -1.0_R8Ki + end do + else if (nLocDst == 1) then + ! Source and destination have one location + ModGlue%Lin%dUdy(iGluDst(1), iGluSrc(1)) = -1.0_R8Ki + else + ! One source location to many destination locations + ModGlue%Lin%dUdy(iGluDst(1):iGluDst(2), iGluSrc(1)) = -1.0_R8Ki + end if + + case (Map_MotionMesh) + + ! Get source and destination meshes + call FAST_OutputMeshPointer(ModSrc, Turbine, Mapping%SrcDL, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(ModDst, Turbine, Mapping%DstDL, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return + + ! Perform linearization based on transfer type + call LinearizeMeshTransfer(Mapping%XfrType, SrcMesh, DstMesh, Mapping%MeshMap); if (Failed()) return + + ! Copy linearization matrices to global dUdy matrix + call Assemble_dUdy_Motions(Mapping, ModMap, ModSrc%Vars, ModDst%Vars, ModGlue%Lin%dUdy) + + ! Copy linearization matrices to global dUdu matrix + call Assemble_dUdu(Mapping, ModMap, ModSrc%Vars, ModDst%Vars, ModGlue%Lin%dUdu) + + case (Map_LoadMesh) + + ! Get source and destination meshes + call FAST_OutputMeshPointer(ModSrc, Turbine, Mapping%SrcDL, SrcMesh, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputMeshPointer(ModDst, Turbine, Mapping%DstDL, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return + + ! Get source and destination displacement meshes (DstDispMesh must be in output) + call FAST_InputMeshPointer(ModSrc, Turbine, Mapping%SrcDispDL, SrcDispMesh, INPUT_CURR, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_OutputMeshPointer(ModDst, Turbine, Mapping%DstDispDL, DstDispMesh, ErrStat2, ErrMsg2); if (Failed()) return + + ! If DstDispMesh is a sibling of DstMesh + if (Mapping%DstUsesSibling) then + + ! Linearize the load mesh transfer + call LinearizeMeshTransfer(Mapping%XfrType, SrcMesh, DstMesh, Mapping%MeshMap, SrcDispMesh, DstDispMesh); if (Failed()) return + + else + + ! Transfer destination displacement mesh to temporary motion mesh (cousin of destination load mesh) + call TransferMesh(Mapping%XfrTypeAux, DstDispMesh, Mapping%TmpMotionMesh, Mapping%MeshMapAux, ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + + ! Linearize the motion mesh transfer + call LinearizeMeshTransfer(Mapping%XfrTypeAux, DstDispMesh, Mapping%TmpMotionMesh, Mapping%MeshMapAux); if (Failed()) return + + ! Linearize the load mesh transfer + call LinearizeMeshTransfer(Mapping%XfrType, SrcMesh, DstMesh, Mapping%MeshMap, SrcDispMesh, Mapping%TmpMotionMesh); if (Failed()) return + + end if + + ! Copy linearization matrices to global dUdy matrix + call Assemble_dUdy_Loads(Mapping, ModMap, ModSrc%Vars, ModDst%Vars, ModGlue%Lin%dUdy) + + ! Copy linearization matrices to global dUdu matrix + call Assemble_dUdu(Mapping, ModMap, ModSrc%Vars, ModDst%Vars, ModGlue%Lin%dUdu) + + end select + + end associate + + end do + +contains + + ! LinearizeMeshTransfer calls the specific linearization function based on + ! transfer type (Point_to_Point, Point_to_Line2, etc.) + subroutine LinearizeMeshTransfer(Typ, Src, Dst, MeshMap, SrcDisp, DstDisp) + integer(IntKi), intent(in) :: Typ + type(MeshType), intent(in) :: Src, Dst + type(MeshMapType), intent(inout) :: MeshMap + type(MeshType), optional, intent(in) :: SrcDisp, DstDisp + select case (Typ) + case (Xfr_Point_to_Point) + call Linearize_Point_to_Point(Src, Dst, MeshMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) + case (Xfr_Point_to_Line2) + call Linearize_Point_to_Line2(Src, Dst, MeshMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) + case (Xfr_Line2_to_Point) + call Linearize_Line2_to_Point(Src, Dst, MeshMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) + case (Xfr_Line2_to_Line2) + call Linearize_Line2_to_Line2(Src, Dst, MeshMap, ErrStat2, ErrMsg2, SrcDisp, DstDisp) + case default + ErrStat2 = ErrID_Fatal + ErrMsg2 = "LinearizeMeshTransfer: unknown transfer type: "//Num2LStr(Typ) + end select + end subroutine + + subroutine Assemble_dUdu(Mapping, ModMap, VarsSrc, VarsDst, dUdu) + type(MappingType), intent(in) :: Mapping + type(VarMapType), intent(in) :: ModMap + type(ModVarsType), intent(in) :: VarsSrc, VarsDst + real(R8Ki), intent(inout) :: dUdu(:, :) + + ! Effect of input Translation Displacement on input Translation Velocity + if (allocated(Mapping%MeshMap%dM%tv_uD)) then + call SumBlock(VarsDst%u, ModMap%iVarDst(FieldTransDisp), VarsDst%u, ModMap%iVarDst(FieldTransVel), Mapping%MeshMap%dM%tv_uD, dUdu) + end if + + ! Effect of input Translation Displacement on input Translation Acceleration + if (allocated(Mapping%MeshMap%dM%ta_uD)) then + call SumBlock(VarsDst%u, ModMap%iVarDst(FieldTransDisp), VarsDst%u, ModMap%iVarDst(FieldTransAcc), Mapping%MeshMap%dM%ta_uD, dUdu) + end if + + ! Effect of input Translation Displacement on input Moments + if (allocated(Mapping%MeshMap%dM%M_uS)) then + call SumBlock(VarsSrc%u, ModMap%iVarSrcDisp(FieldTransDisp), VarsDst%u, ModMap%iVarDst(FieldMoment), Mapping%MeshMap%dM%M_uS, dUdu) + end if + end subroutine + + !> Assemble_dUdy_Loads assembles the linearization matrices for transfer of + !! load fields between two meshes. It sets the following block matrix, which + !! is the dUdy block for transfering output (source) mesh to the input + !! (destination) mesh : + !! M = -| M_li 0 | * M_mi | F^S | + !! | M_fm M_li | | M^S | + subroutine Assemble_dUdy_Loads(Mapping, ModMap, VarsSrc, VarsDst, dUdy) + type(MappingType), intent(inout) :: Mapping + type(VarMapType), intent(in) :: ModMap + type(ModVarsType), intent(in) :: VarsSrc, VarsDst + real(R8Ki), intent(inout) :: dUdy(:, :) + + ! Load identity + if (allocated(Mapping%MeshMap%dM%li)) then + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldForce), VarsDst%u, ModMap%iVarDst(FieldForce), Mapping%MeshMap%dM%li, dUdy) + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldMoment), VarsDst%u, ModMap%iVarDst(FieldMoment), Mapping%MeshMap%dM%li, dUdy) + end if + + ! Force to Moment + if (allocated(Mapping%MeshMap%dM%m_f)) then + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldForce), VarsDst%u, ModMap%iVarDst(FieldMoment), Mapping%MeshMap%dM%m_f, dUdy) + end if + + ! Destination Translation Displacement to Moment + if (allocated(Mapping%MeshMap%dM%m_uD)) then + if (Mapping%DstUsesSibling) then + ! Direct transfer + call SumBlock(VarsDst%y, ModMap%iVarDstDisp(FieldTransDisp), VarsDst%u, ModMap%iVarDst(FieldMoment), Mapping%MeshMap%dM%m_uD, dUdy) + else + ! Compose linearization of motion and loads + Mapping%TmpMatrix = matmul(Mapping%MeshMap%dM%m_uD, Mapping%MeshMapAux%dM%mi) + call SumBlock(VarsDst%y, ModMap%iVarDstDisp(FieldTransDisp), VarsDst%u, ModMap%iVarDst(FieldMoment), Mapping%TmpMatrix, dUdy) + Mapping%TmpMatrix = matmul(Mapping%MeshMap%dM%m_uD, Mapping%MeshMapAux%dM%fx_p) + call SumBlock(VarsDst%y, ModMap%iVarDstDisp(FieldOrientation), VarsDst%u, ModMap%iVarDst(FieldMoment), Mapping%TmpMatrix, dUdy) + end if + end if + end subroutine + + !> Assemble_dUdy_Motions assembles the linearization matrices for transfer of + !! motion fields between two meshes. It set the following block matrix, which + !! is the dUdy block for transfering output (source) mesh to the input + !! (destination) mesh : + !! M = -| M_mi M_f_p 0 0 0 0 | + !! | 0 M_mi 0 0 0 0 | + !! | M_tv_uS 0 M_mi M_f_p 0 0 | + !! | 0 0 0 M_mi 0 0 | + !! | M_ta_uS 0 0 M_ta_rv M_mi M_f_p | + !! | 0 0 0 0 0 M_mi | + !! where the matrices correspond to + !! u^S, theta^S, v^S, omega^S, a^S, alpha^S + subroutine Assemble_dUdy_Motions(Mapping, ModMap, VarsSrc, VarsDst, dUdy) + type(MappingType), intent(in) :: Mapping + type(VarMapType), intent(in) :: ModMap + type(ModVarsType), intent(in) :: VarsSrc, VarsDst + real(R8Ki), intent(inout) :: dUdy(:, :) + + ! Motion identity + if (allocated(Mapping%MeshMap%dM%mi)) then + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldTransDisp), VarsDst%u, ModMap%iVarDst(FieldTransDisp), Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldOrientation), VarsDst%u, ModMap%iVarDst(FieldOrientation), Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldTransVel), VarsDst%u, ModMap%iVarDst(FieldTransVel), Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldAngularVel), VarsDst%u, ModMap%iVarDst(FieldAngularVel), Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldTransAcc), VarsDst%u, ModMap%iVarDst(FieldTransAcc), Mapping%MeshMap%dM%mi, dUdy) + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldAngularAcc), VarsDst%u, ModMap%iVarDst(FieldAngularAcc), Mapping%MeshMap%dM%mi, dUdy) + end if + + ! Rotation to Translation + if (allocated(Mapping%MeshMap%dM%fx_p)) then + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldOrientation), VarsDst%u, ModMap%iVarDst(FieldTransDisp), Mapping%MeshMap%dM%fx_p, dUdy) + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldAngularVel), VarsDst%u, ModMap%iVarDst(FieldTransVel), Mapping%MeshMap%dM%fx_p, dUdy) + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldAngularAcc), VarsDst%u, ModMap%iVarDst(FieldTransAcc), Mapping%MeshMap%dM%fx_p, dUdy) + end if + + ! Translation displacement to Translation velocity + if (allocated(Mapping%MeshMap%dM%tv_us)) then + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldTransDisp), VarsDst%u, ModMap%iVarDst(FieldTransVel), Mapping%MeshMap%dM%tv_us, dUdy) + end if + + ! Translation displacement to Translation acceleration + if (allocated(Mapping%MeshMap%dM%ta_us)) then + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldTransDisp), VarsDst%u, ModMap%iVarDst(FieldTransAcc), Mapping%MeshMap%dM%ta_us, dUdy) + end if + + ! Angular velocity to Translation acceleration + if (allocated(Mapping%MeshMap%dM%ta_rv)) then + call SumBlock(VarsSrc%y, ModMap%iVarSrc(FieldAngularVel), VarsDst%u, ModMap%iVarDst(FieldTransAcc), Mapping%MeshMap%dM%ta_rv, dUdy) + end if + end subroutine + + subroutine SumBlock(VarArySrc, iVarSrc, VarAryDst, iVarDst, SrcM, DstM) + type(ModVarType), intent(in) :: VarArySrc(:), VarAryDst(:) + integer(IntKi), intent(in) :: iVarSrc, iVarDst + real(R8Ki), intent(in) :: SrcM(:, :) + real(R8Ki), intent(inout) :: DstM(:, :) + + ! If no variable index for source or destination, return + if (iVarDst == 0 .or. iVarSrc == 0) return + + ! Get pointers to source and destination locations + associate (iGluSrc => VarArySrc(iVarSrc)%iGlu, iGluDst => VarAryDst(iVarDst)%iGlu) + + ! Subtracts the source matrix from the destination sub-matrix + associate (DstSubM => DstM(iGluDst(1):iGluDst(2), iGluSrc(1):iGluSrc(2))) + DstSubM = DstSubM - SrcM + end associate + + end associate + end subroutine + + logical function Failed() + Failed = ErrStat2 >= AbortErrLev + if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end function +end subroutine + +subroutine VarUnpackInput(ModData, Var, ValAry, T, iInput, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(in) :: ValAry(:) + type(FAST_TurbineType), intent(inout) :: T !< Turbine data + integer(IntKi), intent(in) :: iInput + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + ErrStat = ErrID_None + ErrMsg = '' + select case (ModData%ID) + case (Module_AD) + call AD_VarUnpackInput(Var, ValAry, T%AD%Input(iInput)%rotors(ModData%Ins)) + case (Module_ADsk) + call ADsk_VarUnpackInput(Var, ValAry, T%ADsk%Input(iInput)) + case (Module_BD) + call BD_VarUnpackInput(Var, ValAry, T%BD%Input(iInput, ModData%Ins)) + case (Module_ED) + call ED_VarUnpackInput(Var, ValAry, T%ED%Input(iInput, ModData%Ins)) + case (Module_SED) + call SED_VarUnpackInput(Var, ValAry, T%SED%Input(iInput)) + case (Module_ExtLd) + call ExtLd_VarUnpackInput(Var, ValAry, T%ExtLd%u) + case (Module_ExtInfw) + call ExtInfw_VarUnpackInput(Var, ValAry, T%ExtInfw%u) + case (Module_ExtPtfm) + call ExtPtfm_VarUnpackInput(Var, ValAry, T%ExtPtfm%Input(iInput)) + case (Module_FEAM) + call FEAM_VarUnpackInput(Var, ValAry, T%FEAM%Input(iInput)) + case (Module_HD) + call HydroDyn_VarUnpackInput(Var, ValAry, T%HD%Input(iInput)) + case (Module_IceD) + call IceD_VarUnpackInput(Var, ValAry, T%IceD%Input(iInput, ModData%Ins)) + case (Module_IceF) + call IceFloe_VarUnpackInput(Var, ValAry, T%IceF%Input(iInput)) + case (Module_IfW) + call InflowWind_VarUnpackInput(Var, ValAry, T%IfW%Input(iInput)) + case (Module_MAP) + call MAP_VarUnpackInput(Var, ValAry, T%MAP%Input(iInput)) + case (Module_MD) + call MD_VarUnpackInput(Var, ValAry, T%MD%Input(iInput)) + case (Module_Orca) + call Orca_VarUnpackInput(Var, ValAry, T%Orca%Input(iInput)) + case (Module_SD) + call SD_VarUnpackInput(Var, ValAry, T%SD%Input(iInput)) + case (Module_SeaSt) + call SeaSt_VarUnpackInput(Var, ValAry, T%SeaSt%Input(iInput)) + case (Module_SrvD) + call SrvD_VarUnpackInput(Var, ValAry, T%SrvD%Input(iInput)) + case default + call SetErrStat(ErrID_Fatal, "Unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, "VarPackInput") + end select +end subroutine + +subroutine VarPackOutput(ModData, Var, ValAry, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData + type(ModVarType), intent(in) :: Var + real(R8Ki), intent(inout) :: ValAry(:) + type(FAST_TurbineType), intent(in) :: T !< Turbine data + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + ErrStat = ErrID_None + ErrMsg = '' + select case (ModData%ID) + case (Module_AD) + call AD_VarPackOutput(Var, T%AD%y%rotors(ModData%Ins), ValAry) + case (Module_ADsk) + call ADsk_VarPackOutput(Var, T%ADsk%y, ValAry) + case (Module_BD) + call BD_VarPackOutput(Var, T%BD%y(ModData%Ins), ValAry) + case (Module_ED) + call ED_VarPackOutput(Var, T%ED%y(ModData%Ins), ValAry) + case (Module_SED) + call SED_VarPackOutput(Var, T%SED%y, ValAry) + case (Module_ExtLd) + call ExtLd_VarPackOutput(Var, T%ExtLd%y, ValAry) + case (Module_ExtInfw) + call ExtInfw_VarPackOutput(Var, T%ExtInfw%y, ValAry) + case (Module_ExtPtfm) + call ExtPtfm_VarPackOutput(Var, T%ExtPtfm%y, ValAry) + case (Module_FEAM) + call FEAM_VarPackOutput(Var, T%FEAM%y, ValAry) + case (Module_HD) + call HydroDyn_VarPackOutput(Var, T%HD%y, ValAry) + case (Module_IceD) + call IceD_VarPackOutput(Var, T%IceD%y(ModData%Ins), ValAry) + case (Module_IceF) + call IceFloe_VarPackOutput(Var, T%IceF%y, ValAry) + case (Module_IfW) + call InflowWind_VarPackOutput(Var, T%IfW%y, ValAry) + case (Module_MAP) + call MAP_VarPackOutput(Var, T%MAP%y, ValAry) + case (Module_MD) + call MD_VarPackOutput(Var, T%MD%y, ValAry) + case (Module_Orca) + call Orca_VarPackOutput(Var, T%Orca%y, ValAry) + case (Module_SD) + call SD_VarPackOutput(Var, T%SD%y, ValAry) + case (Module_SeaSt) + call SeaSt_VarPackOutput(Var, T%SeaSt%y, ValAry) + case (Module_SrvD) + call SrvD_VarPackOutput(Var, T%SrvD%y, ValAry) + case default + call SetErrStat(ErrID_Fatal, "Unsupported module: "//ModData%Abbr, ErrStat, ErrMsg, "VarPackOutput") + end select +end subroutine + +subroutine FAST_InputSolve(iModDst, ModAry, MapAry, iInput, Turbine, ErrStat, ErrMsg, VarMapAry) + integer(IntKi), intent(in) :: iModDst !< Destination module index in module data array + type(ModDataType), intent(in) :: ModAry(:) !< Module data + type(MappingType), intent(inout) :: MapAry(:) !< Mesh and variable mappings + integer(IntKi), intent(in) :: iInput !< Input index to store data + type(FAST_TurbineType), target, intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + type(VarMapType), optional, intent(in) :: VarMapAry(:) + + character(*), parameter :: RoutineName = 'FAST_InputSolve' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + if (present(VarMapAry)) then + + ! Loop through mappings and zero load meshes before transfer + do i = 1, size(VarMapAry) + associate (Mapping => MapAry(VarMapAry(i)%iMapping)) + + ! Skip mappings where this isn't the destination module + if (iModDst /= Mapping%iModDst) cycle + + ! Skip mappings that are not ready + if (.not. Mapping%Ready) cycle + + ! If this is a load mesh mapping, clear the loads + if (Mapping%MapType == Map_LoadMesh) call ZeroDstLoadMesh(Mapping, ModAry(VarMapAry(i)%iModDst)) + end associate + end do + + ! Loop through mappings and perform input solve + do i = 1, size(VarMapAry) + associate (Mapping => MapAry(VarMapAry(i)%iMapping)) + + ! Skip mappings where this isn't the destination module + if (iModDst /= VarMapAry(i)%iModDst) cycle + + ! Skip mappings that are not ready + if (.not. Mapping%Ready) cycle + + ! Perform input solve + call InputSolveMapping(MapAry(VarMapAry(i)%iMapping), ModAry(VarMapAry(i)%iModSrc), ModAry(VarMapAry(i)%iModDst)) + if (ErrStat >= AbortErrLev) return + end associate + end do + + else + + ! Loop through mappings and zero load meshes before transfer + do i = 1, size(MapAry) + + ! Skip mappings that are not ready + if (.not. MapAry(i)%Ready) cycle + + ! Skip mappings where this isn't the destination module + if (iModDst /= MapAry(i)%iModDst) cycle + + ! If this is a load mesh mapping, clear the loads + if (MapAry(i)%MapType == Map_LoadMesh) call ZeroDstLoadMesh(MapAry(i), ModAry(MapAry(i)%iModDst)) + end do + + ! Loop through mappings and perform input solve + do i = 1, size(MapAry) + + ! Skip mappings where this isn't the destination module + if (iModDst /= MapAry(i)%iModDst) cycle + + ! Skip mappings that are not ready + if (.not. MapAry(i)%Ready) cycle + + ! Perform input solve + call InputSolveMapping(MapAry(i), ModAry(MapAry(i)%iModSrc), ModAry(MapAry(i)%iModDst)) + if (ErrStat >= AbortErrLev) return + end do + end if + +contains + + subroutine ZeroDstLoadMesh(Mapping, ModDst) + type(MappingType), intent(inout) :: Mapping + type(ModDataType), intent(in) :: ModDst + type(MeshType), pointer :: DstMesh + + ! Get pointer to destination load mesh + call FAST_InputMeshPointer(ModDst, Turbine, Mapping%DstDL, DstMesh, iInput, ErrStat2, ErrMsg2) + if (Failed()) return + + ! If mesh has force, set it to zero + if (DstMesh%fieldmask(MASKID_FORCE)) DstMesh%Force = 0.0_ReKi + + ! If mesh has moment, set it to zero + if (DstMesh%fieldmask(MASKID_MOMENT)) DstMesh%Moment = 0.0_ReKi + + end subroutine + + subroutine InputSolveMapping(Mapping, ModSrc, ModDst) + type(MappingType), intent(inout) :: Mapping + type(ModDataType), intent(in) :: ModSrc, ModDst + type(MeshType), pointer :: SrcMesh, DstMesh + type(MeshType), pointer :: SrcDispMesh, DstDispMesh + + ! Select based on type of mapping + select case (Mapping%MapType) + + case (Map_Custom) + + call Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + case (Map_Variable) + + ! Pack module output value into array + call VarPackOutput(ModSrc, Mapping%SrcVar, Mapping%VarData, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + ! If fewer source values than destination values, copy first value to all values + if (Mapping%SrcVar%Num < Mapping%DstVar%Num) then + Mapping%VarData = Mapping%VarData(1) + end if + + ! Unpack array into module input + call VarUnpackInput(ModDst, Mapping%DstVar, Mapping%VarData, Turbine, iInput, ErrStat2, ErrMsg2) + if (Failed()) return + + case (Map_MotionMesh) + + ! Get source and destination meshes + call FAST_OutputMeshPointer(ModSrc, Turbine, Mapping%SrcDL, SrcMesh, ErrStat2, ErrMsg2) + if (Failed()) return + call FAST_InputMeshPointer(ModDst, Turbine, Mapping%DstDL, DstMesh, iInput, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Perform transfer based on type + call TransferMesh(Mapping%XfrType, SrcMesh, DstMesh, Mapping%MeshMap, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + case (Map_LoadMesh) + + ! Get source and destination meshes + call FAST_OutputMeshPointer(ModSrc, Turbine, Mapping%SrcDL, SrcMesh, ErrStat2, ErrMsg2) + if (Failed()) return + call FAST_InputMeshPointer(ModDst, Turbine, Mapping%DstDL, DstMesh, iInput, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Get source and destination displacement meshes + ! Note: Displacement meshes always references current input index when in input + call FAST_InputMeshPointer(ModSrc, Turbine, Mapping%SrcDispDL, SrcDispMesh, INPUT_CURR, ErrStat2, ErrMsg2) + if (Failed()) return + call FAST_OutputMeshPointer(ModDst, Turbine, Mapping%DstDispDL, DstDispMesh, ErrStat2, ErrMsg2) + if (ErrStat2 == ErrID_Fatal) call FAST_InputMeshPointer(ModDst, Turbine, Mapping%DstDispDL, DstDispMesh, INPUT_CURR, ErrStat2, ErrMsg2) + if (Failed()) return + + ! If DstDispMesh is a sibling of DstMesh + if (Mapping%DstUsesSibling) then + + ! Transfer the load mesh to the temporary load mesh to be summed below + call TransferMesh(Mapping%XfrType, SrcMesh, Mapping%TmpLoadMesh, Mapping%MeshMap, SrcDispMesh, DstDispMesh, ErrStat2, ErrMsg2) + if (Failed()) return + + else + + ! Transfer destination displacement mesh to temporary motion mesh (cousin of destination load mesh) + call TransferMesh(Mapping%XfrTypeAux, DstDispMesh, Mapping%TmpMotionMesh, Mapping%MeshMapAux, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + ! Transfer to temporary load mesh using the temporary motion mesh as the destination displacement mesh + call TransferMesh(Mapping%XfrType, SrcMesh, Mapping%TmpLoadMesh, Mapping%MeshMap, SrcDispMesh, Mapping%TmpMotionMesh, ErrStat2, ErrMsg2) + if (Failed()) return + + end if + + ! Sum loads from temporary mesh to destination mesh + if (DstMesh%fieldmask(MASKID_FORCE)) DstMesh%Force = DstMesh%Force + Mapping%TmpLoadMesh%Force + if (DstMesh%fieldmask(MASKID_MOMENT)) DstMesh%Moment = DstMesh%Moment + Mapping%TmpLoadMesh%Moment + + end select + + end subroutine + + logical function Failed() + Failed = ErrStat2 /= ErrID_None + if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, & + RoutineName//':Module='//trim(ModAry(iModDst)%Abbr)// & + ', Instance='//Num2LStr(ModAry(iModDst)%Ins)) + end function +end subroutine + +! Reset mapping read flags +subroutine FAST_ResetMappingReady(MapAry) + type(MappingType), intent(inout) :: MapAry(:) !< Mesh and variable mappings + integer(IntKi) :: i + do i = 1, size(MapAry) + select case (MapAry(i)%SrcModID) + case default ! Default to transfer is not ready + MapAry(i)%Ready = .false. + end select + end do +end subroutine + +! TransferMesh calls the specific transfer function based on +! transfer type (Point_to_Point, Point_to_Line2, etc.) +subroutine TransferMesh(Typ, Src, Dst, MeshMap, SrcDisp, DstDisp, ErrStat, ErrMsg) + integer(IntKi), intent(in) :: Typ + type(MeshType), intent(in) :: Src + type(MeshType), intent(inout) :: Dst + type(MeshMapType), intent(inout) :: MeshMap + type(MeshType), optional, intent(in) :: SrcDisp, DstDisp + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + select case (Typ) + case (Xfr_Point_to_Point) + call Transfer_Point_to_Point(Src, Dst, MeshMap, ErrStat, ErrMsg, SrcDisp, DstDisp) + case (Xfr_Point_to_Line2) + call Transfer_Point_to_Line2(Src, Dst, MeshMap, ErrStat, ErrMsg, SrcDisp, DstDisp) + case (Xfr_Line2_to_Point) + call Transfer_Line2_to_Point(Src, Dst, MeshMap, ErrStat, ErrMsg, SrcDisp, DstDisp) + case (Xfr_Line2_to_Line2) + call Transfer_Line2_to_Line2(Src, Dst, MeshMap, ErrStat, ErrMsg, SrcDisp, DstDisp) + case default + ErrStat = ErrID_Fatal + ErrMsg = "TransferMesh: unknown transfer type: "//Num2LStr(Typ) + end select +end subroutine + +subroutine Custom_InputSolve(Mapping, ModSrc, ModDst, iInput, T, ErrStat, ErrMsg) + type(MappingType), intent(inout) :: Mapping + type(ModDataType), intent(in) :: ModSrc, ModDst + integer(IntKi), intent(in) :: iInput + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'Custom_InputSolve' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, k + + real(R8Ki) :: omega_c(3) + real(R8Ki) :: r(3), r_hub(3) + real(R8Ki) :: Vrot(3) + + ErrStat = ErrID_None + ErrMsg = '' + + ! Select based on mapping description + select case (Mapping%Desc) + +!------------------------------------------------------------------------------- +! AeroDyn Inputs +!------------------------------------------------------------------------------- + + case (Custom_SrvD_to_AD) + + ! 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) + ! Commanded Airfoil UserProp for blade (must be same units as given in AD15 airfoil tables) + ! This is passed to AD15 to be interpolated with the airfoil table userprop column + ! (might be used for airfoil flap angles for example) + ! Must be same units as given in airfoil (no unit conversions handled in code)ß + do i = 1, size(T%AD%Input(iInput)%rotors(ModDst%Ins)%UserProp, dim=2) ! Blade + T%AD%Input(iInput)%rotors(ModDst%Ins)%UserProp(:, i) = T%SrvD%y%BlAirfoilCom(i) + end do + +!------------------------------------------------------------------------------- +! ADsk Inputs +!------------------------------------------------------------------------------- + + case (Custom_ED_to_ADsk) + + T%ADsk%Input(iInput)%RotSpeed = T%ED%y(ModSrc%Ins)%RotSpeed + T%ADsk%Input(iInput)%BlPitch = T%ED%y(ModSrc%Ins)%BlPitch(1) ! ADsk only uses collective blade pitch + + case (Custom_SED_to_ADsk) + + T%ADsk%Input(iInput)%RotSpeed = T%SED%y%RotSpeed + T%ADsk%Input(iInput)%BlPitch = T%SED%y%BlPitch(1) ! ADsk only uses collective blade pitch + +!------------------------------------------------------------------------------- +! BeamDyn Inputs +!------------------------------------------------------------------------------- + + case (Custom_BD_Blade_Damping) + + ! Get rotational velocity and current hub position + ! TODO: correlate ED instance with BD instance + omega_c = T%ED%y(1)%RotSpeed * T%ED%y(1)%HubPtMotion%Orientation(1,:,1) + r_hub = T%ED%y(1)%HubPtMotion%Position(:,1) + T%ED%y(1)%HubPtMotion%TranslationDisp(:,1) + + ! Get blade velocities at load mesh locations + call TransferMesh(Mapping%XfrType, T%BD%y(Mapping%DstIns)%BldMotion, Mapping%TmpMotionMesh, Mapping%MeshMap, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + ! Remove rotor rotational velocity from node velocity + do i = 1, Mapping%TmpMotionMesh%Nnodes + r = Mapping%TmpMotionMesh%Position(:,i) + Mapping%TmpMotionMesh%TranslationDisp(:,i) - r_hub + Vrot = cross_product(omega_c, r) + Mapping%TmpMotionMesh%TranslationVel(:,i) = Mapping%TmpMotionMesh%TranslationVel(:,i) - Vrot + end do + + ! Apply damping force as Bld_Kdmp*(node velocity) + T%BD%Input(iInput, Mapping%DstIns)%DistrLoad%Force = T%BD%Input(iInput, Mapping%DstIns)%DistrLoad%Force - T%p_FAST%Bld_Kdmp * Mapping%TmpMotionMesh%TranslationVel + +!------------------------------------------------------------------------------- +! ElastoDyn Inputs +!------------------------------------------------------------------------------- + + case (Custom_SrvD_to_ED) + + T%ED%Input(iInput, ModDst%Ins)%GenTrq = T%SrvD%y%GenTrq + T%ED%Input(iInput, ModDst%Ins)%HSSBrTrqC = T%SrvD%y%HSSBrTrqC + T%ED%Input(iInput, ModDst%Ins)%BlPitchCom = T%SrvD%y%BlPitchCom + T%ED%Input(iInput, ModDst%Ins)%YawMom = T%SrvD%y%YawMom + + case (Custom_ED_Tower_Damping) + + ! Get tower velocities at load mesh locations + call TransferMesh(Mapping%XfrType, T%ED%y(ModDst%Ins)%TowerLn2Mesh, Mapping%TmpMotionMesh, Mapping%MeshMap, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + ! Apply damping force as Twr_Kdmp*(node velocity) + T%ED%Input(iInput, Mapping%DstIns)%TowerPtLoads%Force = T%ED%Input(iInput, Mapping%DstIns)%TowerPtLoads%Force - T%p_FAST%Twr_Kdmp * Mapping%TmpMotionMesh%TranslationVel + + case (Custom_ED_Blade_Damping) + + ! Get rotational velocity and current hub position + ! TODO: correlate ED instance with BD instance + omega_c = T%ED%y(ModDst%Ins)%RotSpeed * T%ED%y(ModDst%Ins)%HubPtMotion%Orientation(1,:,1) + r_hub = T%ED%y(ModDst%Ins)%HubPtMotion%Position(:,1) + T%ED%y(ModDst%Ins)%HubPtMotion%TranslationDisp(:,1) + + ! Get blade velocities at load mesh locations + call TransferMesh(Mapping%XfrType, T%ED%y(1)%BladeLn2Mesh(Mapping%i), Mapping%TmpMotionMesh, Mapping%MeshMap, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + ! Remove rotor rotational velocity from node velocity + do i = 1, Mapping%TmpMotionMesh%Nnodes + r = Mapping%TmpMotionMesh%Position(:,i) + Mapping%TmpMotionMesh%TranslationDisp(:,i) - r_hub + Vrot = cross_product(omega_c, r) + Mapping%TmpMotionMesh%TranslationVel(:,i) = Mapping%TmpMotionMesh%TranslationVel(:,i) - Vrot + end do + + ! Apply damping force as Bld_Kdmp*(node velocity) + T%ED%Input(iInput, Mapping%DstIns)%BladePtLoads(Mapping%i)%Force = T%ED%Input(iInput, Mapping%DstIns)%BladePtLoads(Mapping%i)%Force - T%p_FAST%Bld_Kdmp * Mapping%TmpMotionMesh%TranslationVel + +!------------------------------------------------------------------------------- +! SED Inputs +!------------------------------------------------------------------------------- + + case (Custom_SrvD_to_SED) + + T%SED%Input(iInput)%GenTrq = T%SrvD%y%GenTrq + T%SED%Input(iInput)%HSSBrTrqC = T%SrvD%y%HSSBrTrqC + T%SED%Input(iInput)%BlPitchCom = T%SrvD%y%BlPitchCom + T%SED%Input(iInput)%YawPosCom = T%SrvD%y%YawPosCom + T%SED%Input(iInput)%YawRateCom = T%SrvD%y%YawRateCom + +!------------------------------------------------------------------------------- +! ExtLoads Inputs +!------------------------------------------------------------------------------- + + case (Custom_ED_to_ExtLd) + + T%ExtLd%u%az = T%ED%y(ModSrc%Ins)%LSSTipPxa + T%ExtLd%u%DX_u%bldPitch(:) = T%ED%y(ModSrc%Ins)%BlPitch + + ! Note: this may be better inside CalcOutput + call ExtLd_ConvertInpDataForExtProg(T%ExtLd%u, T%ExtLd%p, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + +!------------------------------------------------------------------------------- +! InflowWind Inputs +!------------------------------------------------------------------------------- + + case (Custom_ED_to_IfW) + + ! This section should be refactored so that IfW uses a hub point mesh + T%IfW%Input(iInput)%HubPosition = T%ED%y(ModSrc%Ins)%HubPtMotion%Position(:, 1) + & + T%ED%y(ModSrc%Ins)%HubPtMotion%TranslationDisp(:, 1) + T%IfW%Input(iInput)%HubOrientation = T%ED%y(ModSrc%Ins)%HubPtMotion%Orientation(:, :, 1) + + ! Set Lidar position directly from hub motion mesh + T%IfW%Input(iInput)%lidar%HubDisplacementX = T%ED%y(ModSrc%Ins)%HubPtMotion%TranslationDisp(1, 1) + T%IfW%Input(iInput)%lidar%HubDisplacementY = T%ED%y(ModSrc%Ins)%HubPtMotion%TranslationDisp(2, 1) + T%IfW%Input(iInput)%lidar%HubDisplacementZ = T%ED%y(ModSrc%Ins)%HubPtMotion%TranslationDisp(3, 1) + + case (Custom_SED_to_IfW) + + ! This section should be refactored so that IfW uses a hub point mesh + T%IfW%Input(iInput)%HubPosition = T%SED%y%HubPtMotion%Position(:, 1) + & + T%SED%y%HubPtMotion%TranslationDisp(:, 1) + T%IfW%Input(iInput)%HubOrientation = T%SED%y%HubPtMotion%Orientation(:, :, 1) + + ! Set Lidar position directly from hub motion mesh + T%IfW%Input(iInput)%lidar%HubDisplacementX = T%SED%y%HubPtMotion%TranslationDisp(1, 1) + T%IfW%Input(iInput)%lidar%HubDisplacementY = T%SED%y%HubPtMotion%TranslationDisp(2, 1) + T%IfW%Input(iInput)%lidar%HubDisplacementZ = T%SED%y%HubPtMotion%TranslationDisp(3, 1) + + case (Custom_SrvD_to_IfW) + +!------------------------------------------------------------------------------- +! MoorDyn Inputs +!------------------------------------------------------------------------------- + + case (Custom_SrvD_to_MD) + + if (allocated(T%MD%Input(iInput)%DeltaL) .and. allocated(T%SrvD%y%CableDeltaL)) then + T%MD%Input(iInput)%DeltaL = T%SrvD%y%CableDeltaL ! these should be sized identically during init + end if + + if (allocated(T%MD%Input(iInput)%DeltaLdot) .and. allocated(T%SrvD%y%CableDeltaLdot)) then + T%MD%Input(iInput)%DeltaLdot = T%SrvD%y%CableDeltaLdot ! these should be sized identically during init + end if + +!------------------------------------------------------------------------------- +! SubDyn Inputs +!------------------------------------------------------------------------------- + + case (Custom_SrvD_to_SD) + + if (allocated(T%SD%Input(iInput)%CableDeltaL) .and. allocated(T%SrvD%y%CableDeltaL)) then + T%SD%Input(iInput)%CableDeltaL = T%SrvD%y%CableDeltaL ! these should be sized identically during init + end if + +!------------------------------------------------------------------------------- +! ServoDyn Inputs +!------------------------------------------------------------------------------- + + case (Custom_BD_to_SrvD) + + ! TODO: correlate BD instance to ED instance + T%SrvD%Input(iInput)%RootMxc(Mapping%SrcIns) = T%BD%y(Mapping%SrcIns)%RootMxr*cos(T%ED%y(1)%BlPitch(Mapping%SrcIns)) + & + T%BD%y(Mapping%SrcIns)%RootMyr*sin(T%ED%y(1)%BlPitch(Mapping%SrcIns)) + T%SrvD%Input(iInput)%RootMyc(Mapping%SrcIns) = -T%BD%y(Mapping%SrcIns)%RootMxr*sin(T%ED%y(1)%BlPitch(Mapping%SrcIns)) + & + T%BD%y(Mapping%SrcIns)%RootMyr*cos(T%ED%y(1)%BlPitch(Mapping%SrcIns)) + + case (Custom_ED_to_SrvD) + + ! Blade root moment if not using BeamDyn + if (T%p_FAST%CompElast /= Module_BD) then + T%SrvD%Input(iInput)%RootMxc = T%ED%y(ModSrc%Ins)%RootMxc ! fixed-size arrays: always size 3 + T%SrvD%Input(iInput)%RootMyc = T%ED%y(ModSrc%Ins)%RootMyc ! fixed-size arrays: always size 3 + end if + + T%SrvD%Input(iInput)%YawAngle = T%ED%y(ModSrc%Ins)%YawAngle ! nacelle yaw plus platform yaw + T%SrvD%Input(iInput)%YawErr = T%SrvD%Input(iInput)%WindDir - T%SrvD%Input(iInput)%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) + + T%SrvD%Input(iInput)%BlPitch = T%ED%y(ModSrc%Ins)%BlPitch + T%SrvD%Input(iInput)%LSS_Spd = T%ED%y(ModSrc%Ins)%LSS_Spd + T%SrvD%Input(iInput)%RotSpeed = T%ED%y(ModSrc%Ins)%RotSpeed + + T%SrvD%Input(iInput)%YawBrTAxp = T%ED%y(ModSrc%Ins)%YawBrTAxp + T%SrvD%Input(iInput)%YawBrTAyp = T%ED%y(ModSrc%Ins)%YawBrTAyp + T%SrvD%Input(iInput)%LSSTipPxa = T%ED%y(ModSrc%Ins)%LSSTipPxa + + T%SrvD%Input(iInput)%LSSTipMxa = T%ED%y(ModSrc%Ins)%LSSTipMxa + T%SrvD%Input(iInput)%LSSTipMya = T%ED%y(ModSrc%Ins)%LSSTipMya + T%SrvD%Input(iInput)%LSSTipMza = T%ED%y(ModSrc%Ins)%LSSTipMza + T%SrvD%Input(iInput)%LSSTipMys = T%ED%y(ModSrc%Ins)%LSSTipMys + T%SrvD%Input(iInput)%LSSTipMzs = T%ED%y(ModSrc%Ins)%LSSTipMzs + + T%SrvD%Input(iInput)%YawBrMyn = T%ED%y(ModSrc%Ins)%YawBrMyn + T%SrvD%Input(iInput)%YawBrMzn = T%ED%y(ModSrc%Ins)%YawBrMzn + T%SrvD%Input(iInput)%NcIMURAxs = T%ED%y(ModSrc%Ins)%NcIMURAxs + T%SrvD%Input(iInput)%NcIMURAys = T%ED%y(ModSrc%Ins)%NcIMURAys + T%SrvD%Input(iInput)%NcIMURAzs = T%ED%y(ModSrc%Ins)%NcIMURAzs + + T%SrvD%Input(iInput)%RotPwr = T%ED%y(ModSrc%Ins)%RotPwr + + T%SrvD%Input(iInput)%LSShftFxa = T%ED%y(ModSrc%Ins)%LSShftFxa + T%SrvD%Input(iInput)%LSShftFys = T%ED%y(ModSrc%Ins)%LSShftFys + T%SrvD%Input(iInput)%LSShftFzs = T%ED%y(ModSrc%Ins)%LSShftFzs + + case (Custom_SED_to_SrvD) + + ! ServoDyn inputs from combination of InflowWind and ElastoDyn + T%SrvD%Input(iInput)%YawAngle = T%SED%y%Yaw !nacelle yaw (platform rigid) + T%SrvD%Input(iInput)%YawErr = T%SrvD%Input(iInput)%WindDir - T%SrvD%Input(iInput)%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) + + ! ServoDyn inputs from Simplified-ElastoDyn + T%SrvD%Input(iInput)%Yaw = T%SED%y%Yaw !nacelle yaw + T%SrvD%Input(iInput)%YawRate = T%SED%y%YawRate + T%SrvD%Input(iInput)%LSS_Spd = T%SED%y%RotSpeed + T%SrvD%Input(iInput)%HSS_Spd = T%SED%y%HSS_Spd + T%SrvD%Input(iInput)%RotSpeed = T%SED%y%RotSpeed + T%SrvD%Input(iInput)%BlPitch = T%SED%y%BlPitch + + ! root moments + T%SrvD%Input(iInput)%RootMxc = 0.0_ReKi ! y_ED%RootMxc ! fixed-size arrays: always size 3 + T%SrvD%Input(iInput)%RootMyc = 0.0_ReKi ! y_ED%RootMyc ! fixed-size arrays: always size 3 + + T%SrvD%Input(iInput)%YawBrTAxp = 0.0_ReKi ! y_ED%YawBrTAxp + T%SrvD%Input(iInput)%YawBrTAyp = 0.0_ReKi ! y_ED%YawBrTAyp + T%SrvD%Input(iInput)%LSSTipPxa = T%SED%y%LSSTipPxa + + T%SrvD%Input(iInput)%LSSTipMxa = T%SED%y%RotTrq + T%SrvD%Input(iInput)%LSSTipMya = 0.0_ReKi ! y_ED%LSSTipMya + T%SrvD%Input(iInput)%LSSTipMza = 0.0_ReKi ! y_ED%LSSTipMza + T%SrvD%Input(iInput)%LSSTipMys = 0.0_ReKi ! y_ED%LSSTipMys + T%SrvD%Input(iInput)%LSSTipMzs = 0.0_ReKi ! y_ED%LSSTipMzs + + T%SrvD%Input(iInput)%YawBrMyn = 0.0_ReKi ! y_ED%YawBrMyn + T%SrvD%Input(iInput)%YawBrMzn = 0.0_ReKi ! y_ED%YawBrMzn + T%SrvD%Input(iInput)%NcIMURAxs = 0.0_ReKi ! y_ED%NcIMURAxs + T%SrvD%Input(iInput)%NcIMURAys = 0.0_ReKi ! y_ED%NcIMURAys + T%SrvD%Input(iInput)%NcIMURAzs = 0.0_ReKi ! y_ED%NcIMURAzs + + T%SrvD%Input(iInput)%RotPwr = T%SED%y%RotPwr + + T%SrvD%Input(iInput)%LSShftFxa = 0.0_ReKi ! y_ED%LSShftFxa + T%SrvD%Input(iInput)%LSShftFys = 0.0_ReKi ! y_ED%LSShftFys + T%SrvD%Input(iInput)%LSShftFzs = 0.0_ReKi ! y_ED%LSShftFzs + + case (Custom_IfW_to_SrvD) + + T%SrvD%Input(iInput)%WindDir = atan2(T%IfW%y%HubVel(2), T%IfW%y%HubVel(1)) + T%SrvD%Input(iInput)%HorWindV = sqrt(T%IfW%y%HubVel(1)**2 + T%IfW%y%HubVel(2)**2) + if (allocated(T%IfW%y%lidar%LidSpeed)) T%SrvD%Input(iInput)%LidSpeed = T%IfW%y%lidar%LidSpeed + if (allocated(T%IfW%y%lidar%MsrPositionsX)) T%SrvD%Input(iInput)%MsrPositionsX = T%IfW%y%lidar%MsrPositionsX + if (allocated(T%IfW%y%lidar%MsrPositionsY)) T%SrvD%Input(iInput)%MsrPositionsY = T%IfW%y%lidar%MsrPositionsY + if (allocated(T%IfW%y%lidar%MsrPositionsZ)) T%SrvD%Input(iInput)%MsrPositionsZ = T%IfW%y%lidar%MsrPositionsZ + T%SrvD%Input(iInput)%YawErr = T%SrvD%Input(iInput)%WindDir - T%SrvD%Input(iInput)%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) + + case (Custom_ExtInfw_to_SrvD) + + T%SrvD%Input(iInput)%WindDir = ATAN2(T%ExtInfw%y%v(1), T%ExtInfw%y%u(1)) + T%SrvD%Input(iInput)%HorWindV = SQRT(T%ExtInfw%y%u(1)**2 + T%ExtInfw%y%v(1)**2) + if (allocated(T%SrvD%Input(iInput)%LidSpeed)) T%SrvD%Input(iInput)%LidSpeed = 0.0 + if (allocated(T%SrvD%Input(iInput)%MsrPositionsX)) T%SrvD%Input(iInput)%MsrPositionsX = 0.0 + if (allocated(T%SrvD%Input(iInput)%MsrPositionsY)) T%SrvD%Input(iInput)%MsrPositionsY = 0.0 + if (allocated(T%SrvD%Input(iInput)%MsrPositionsz)) T%SrvD%Input(iInput)%MsrPositionsz = 0.0 + + ! the nacelle yaw error estimate (positive about zi-axis) + T%SrvD%Input(iInput)%YawErr = T%SrvD%Input(iInput)%WindDir - T%SrvD%Input(iInput)%YawAngle + +!------------------------------------------------------------------------------- +! Unknown Mapping +!------------------------------------------------------------------------------- + + case default + + ErrStat = ErrID_Fatal + ErrMsg = "Custom_InputSolve: unknown mapping '"//trim(Mapping%Desc)//"'" + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine FAST_ResetRemapFlags(Mods, Maps, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: Mods(:) !< Module data + type(MappingType), intent(inout) :: Maps(:) + type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_ResetRemapFlags' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, k + type(MeshType), pointer :: SrcMesh, DstMesh + + ErrStat = ErrID_None + ErrMsg = '' + + ! Reset remap flags in mapping meshes + do i = 1, size(Maps) + select case (Maps(i)%MapType) + case (Map_LoadMesh, Map_MotionMesh) + + if (associated(Maps(i)%TmpLoadMesh%RemapFlag)) Maps(i)%TmpLoadMesh%RemapFlag = .false. + if (associated(Maps(i)%TmpMotionMesh%RemapFlag)) Maps(i)%TmpMotionMesh%RemapFlag = .false. + + call FAST_OutputMeshPointer(Mods(Maps(i)%iModSrc), T, Maps(i)%SrcDL, SrcMesh, ErrStat2, ErrMsg2) + if (Failed()) return + SrcMesh%RemapFlag = .false. + + call FAST_InputMeshPointer(Mods(Maps(i)%iModDst), T, Maps(i)%DstDL, DstMesh, INPUT_CURR, ErrStat2, ErrMsg2) + if (Failed()) return + DstMesh%RemapFlag = .false. + + end select + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +end module diff --git a/modules/openfast-library/src/FAST_ModGlue.f90 b/modules/openfast-library/src/FAST_ModGlue.f90 new file mode 100644 index 0000000000..858c28618d --- /dev/null +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -0,0 +1,1620 @@ +!********************************************************************************************************************************** +! FAST_ModGlue.f90 performs linearization using the ModVars module. +!.................................................................................................................................. +! LICENSING +! Copyright (C) 2024 National Renewable Energy Laboratory +! +! This file is part of FAST. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +!********************************************************************************************************************************** +module FAST_ModGlue + +use NWTC_Library +use NWTC_LAPACK + +use FAST_ModTypes +use FAST_Types +use FAST_Funcs +use FAST_Mapping + +implicit none + +private +public :: ModGlue_Init +public :: ModGlue_Linearize_OP, ModGlue_CalcSteady +public :: ModGlue_SaveOperatingPoint, ModGlue_RestoreOperatingPoint +public :: CalcWriteLinearMatrices, Glue_CombineModules + +contains + +subroutine Glue_CombineModules(ModGlue, ModDataAry, Mappings, iModAry, FlagFilter, Linearize, ErrStat, ErrMsg, Name) + type(ModGlueType), intent(out) :: ModGlue + type(ModDataType), intent(in) :: ModDataAry(:) + integer(IntKi), intent(in) :: iModAry(:) + integer(IntKi), intent(in) :: FlagFilter + logical, intent(in) :: Linearize + type(MappingType), intent(in) :: Mappings(:) !< Mesh and variable mappings + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + character(*), optional, intent(in) :: Name + + character(*), parameter :: RoutineName = 'Glue_CombineModules' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: iGbl(2) + integer(IntKi) :: i, j, k + integer(IntKi) :: iMod, iVarGlue + integer(IntKi) :: xNumVals, zNumVals, uNumVals, yNumVals + integer(IntKi) :: xNumVars, zNumVars, uNumVars, yNumVars + integer(IntKi) :: ix, iz, iu, iy + character(20) :: NamePrefix + type(VarMapType) :: ModMap + + ! Initialize error return + ErrStat = ErrID_None + ErrMsg = "" + + ! If no modules or order is empty, return error + if ((size(ModDataAry) == 0) .or. (size(iModAry) == 0)) then + call SetErrStat(ErrID_Fatal, "No modules were used", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Set module name + if (present(Name)) then + ModGlue%Name = Name + else + ModGlue%Name = '' + end if + + !---------------------------------------------------------------------------- + ! Allocate module data array + !---------------------------------------------------------------------------- + + ! Allocate module info array based on number of modules in iMod + allocate (ModGlue%ModData(size(iModAry)), stat=ErrStat2) + if (FailedAlloc("ModOut%VarsAry")) return + + !---------------------------------------------------------------------------- + ! Combine modules into glue module + !---------------------------------------------------------------------------- + + ! Initialize number of variables and values in each group + xNumVars = 0; zNumVars = 0; uNumVars = 0; yNumVars = 0 + xNumVals = 0; zNumVals = 0; uNumVals = 0; yNumVals = 0 + + ! Loop through each module and sum the number of variables that will be in + ! the combined module + do i = 1, size(iModAry) + associate (ModData => ModDataAry(iModAry(i)), GlueModData => ModGlue%ModData(i)) + + ! Copy values from source module info + GlueModData%Abbr = ModData%Abbr + GlueModData%ID = ModData%ID + GlueModData%iMod = ModData%iMod ! Keep original module index for input solve + GlueModData%Ins = ModData%Ins + GlueModData%DT = ModData%DT + GlueModData%SubSteps = ModData%SubSteps + + ! Continuous state + call CopyVariables(ModData%Vars%x, GlueModData%Vars%x, xNumVals); if (Failed()) return + GlueModData%Vars%Nx = ModData%Vars%Nx ! Same as original module + xNumVars = xNumVars + size(GlueModData%Vars%x) + + ! Constraint state + call CopyVariables(ModData%Vars%z, GlueModData%Vars%z, zNumVals); if (Failed()) return + GlueModData%Vars%Nz = ModData%Vars%Nz ! Same as original module + zNumVars = zNumVars + size(GlueModData%Vars%z) + + ! Input + call CopyVariables(ModData%Vars%u, GlueModData%Vars%u, uNumVals); if (Failed()) return + GlueModData%Vars%Nu = ModData%Vars%Nu ! Same as original module + uNumVars = uNumVars + size(GlueModData%Vars%u) + + ! Output + call CopyVariables(ModData%Vars%y, GlueModData%Vars%y, yNumVals); if (Failed()) return + GlueModData%Vars%Ny = ModData%Vars%Ny ! Same as original module + yNumVars = yNumVars + size(GlueModData%Vars%y) + + end associate + end do + + ! Set total number of values in glue module + ModGlue%Vars%Nx = xNumVals + ModGlue%Vars%Nz = zNumVals + ModGlue%Vars%Nu = uNumVals + ModGlue%Vars%Ny = yNumVals + + ! Allocate arrays for to hold combined variables + allocate (ModGlue%Vars%x(xNumVars), stat=ErrStat2); if (FailedAlloc("ModOut%Vars%x")) return + allocate (ModGlue%Vars%z(zNumVars), stat=ErrStat2); if (FailedAlloc("ModOut%Vars%z")) return + allocate (ModGlue%Vars%u(uNumVars), stat=ErrStat2); if (FailedAlloc("ModOut%Vars%u")) return + allocate (ModGlue%Vars%y(yNumVars), stat=ErrStat2); if (FailedAlloc("ModOut%Vars%y")) return + + ! Loop through module info in glue module + ix = 0; iz = 0; iu = 0; iy = 0 + do i = 1, size(ModGlue%ModData) + + associate (GlueModData => ModGlue%ModData(i)) + + ! Determine module name prefix for linearization + if ((GlueModData%ID == Module_BD) .or. (count(ModDataAry%ID == GlueModData%ID) > 1)) then + NamePrefix = trim(GlueModData%Abbr)//"_"//Num2LStr(GlueModData%Ins) + GlueModData%Abbr = trim(GlueModData%Abbr)//Num2LStr(GlueModData%Ins) + else + NamePrefix = GlueModData%Abbr + GlueModData%Abbr = GlueModData%Abbr + end if + + ! Continuous state + do j = 1, size(GlueModData%Vars%x) + ix = ix + 1 + ModGlue%Vars%x(ix) = GlueModData%Vars%x(j) + ModGlue%Vars%x(ix)%iLoc = ModGlue%Vars%x(ix)%iGlu ! Set local indices to glue indices + ModGlue%Vars%x(ix)%iGlu = 0 ! Set glue indices to 0 + call AddLinNamePrefix(ModGlue%Vars%x(ix), NamePrefix) + end do + + ! Constraint state + do j = 1, size(GlueModData%Vars%z) + iz = iz + 1 + ModGlue%Vars%z(iz) = GlueModData%Vars%z(j) + ModGlue%Vars%z(iz)%iLoc = ModGlue%Vars%z(iz)%iGlu ! Set local indices to glue indices + ModGlue%Vars%z(iz)%iGlu = 0 ! Set glue indices to 0 + call AddLinNamePrefix(ModGlue%Vars%z(iz), NamePrefix) + end do + + ! Input + do j = 1, size(GlueModData%Vars%u) + iu = iu + 1 + ModGlue%Vars%u(iu) = GlueModData%Vars%u(j) + ModGlue%Vars%u(iu)%iLoc = ModGlue%Vars%u(iu)%iGlu ! Set local indices to glue indices + ModGlue%Vars%u(iu)%iGlu = 0 ! Set glue indices to 0 + call AddLinNamePrefix(ModGlue%Vars%u(iu), NamePrefix) + end do + + ! Output + do j = 1, size(GlueModData%Vars%y) + iy = iy + 1 + ModGlue%Vars%y(iy) = GlueModData%Vars%y(j) + ModGlue%Vars%y(iy)%iLoc = ModGlue%Vars%y(iy)%iGlu ! Set local indices to glue indices + ModGlue%Vars%y(iy)%iGlu = 0 ! Set glue indices to 0 + call AddLinNamePrefix(ModGlue%Vars%y(iy), NamePrefix) + end do + + end associate + end do + + !---------------------------------------------------------------------------- + ! Determine mappings which apply to the modules in this glue module + !---------------------------------------------------------------------------- + + allocate (ModGlue%VarMaps(0)) + + ! Loop through mappings + do i = 1, size(Mappings) + + ! Find index of source module in glue module, cycle if not found + ModMap%iModSrc = 0 + do j = 1, size(iModAry) + if (iModAry(j) == Mappings(i)%iModSrc) then + ModMap%iModSrc = j + exit + end if + end do + if (ModMap%iModSrc == 0) cycle + + ! Find index of destination module in glue module, cycle if not found + ModMap%iModDst = 0 + do j = 1, size(iModAry) + if (iModAry(j) == Mappings(i)%iModDst) then + ModMap%iModDst = j + exit + end if + end do + if (ModMap%iModDst == 0) cycle + + ! Get source and destination modules from glue module data array + associate (Mapping => Mappings(i), & + ModSrc => ModGlue%ModData(ModMap%iModSrc), & + ModDst => ModGlue%ModData(ModMap%iModDst)) + + ! Set mapping index and clear variable indices + ModMap%iMapping = i + ModMap%iVarSrc = 0 + ModMap%iVarSrcDisp = 0 + ModMap%iVarDst = 0 + ModMap%iVarDstDisp = 0 + + ! Init variable indices and find indices that apply to the source data location + select case (Mapping%MapType) + case (Map_Variable) + + do j = 1, size(ModSrc%Vars%y) + if (MV_EqualDL(ModSrc%Vars%y(j)%DL, Mapping%SrcDL)) ModMap%iVarSrc(1) = j + end do + + case (Map_LoadMesh, Map_MotionMesh) + + do j = 1, size(ModSrc%Vars%y) + if (MV_EqualDL(ModSrc%Vars%y(j)%DL, Mapping%SrcDL)) ModMap%iVarSrc(ModSrc%Vars%y(j)%Field) = j + end do + + if (Mapping%MapType == Map_LoadMesh) then + do j = 1, size(ModSrc%Vars%u) + if (MV_EqualDL(ModSrc%Vars%u(j)%DL, Mapping%SrcDispDL)) ModMap%iVarSrcDisp(ModSrc%Vars%u(j)%Field) = j + end do + end if + + end select + + ! If no source variable indices found, cycle + if (all(ModMap%iVarSrc == 0)) cycle + if (Mapping%MapType == Map_LoadMesh .and. all(ModMap%iVarSrcDisp == 0)) cycle + + ! Init variable indices and find indices that apply to the destination data location + select case (Mapping%MapType) + case (Map_Variable) + + do j = 1, size(ModDst%Vars%u) + if (MV_EqualDL(ModDst%Vars%u(j)%DL, Mapping%DstDL)) ModMap%iVarDst(1) = j + end do + + case (Map_LoadMesh, Map_MotionMesh) + + do j = 1, size(ModDst%Vars%u) + if (MV_EqualDL(ModDst%Vars%u(j)%DL, Mapping%DstDL)) ModMap%iVarDst(ModDst%Vars%u(j)%Field) = j + end do + + if (Mapping%MapType == Map_LoadMesh) then + do j = 1, size(ModDst%Vars%y) + if (MV_EqualDL(ModDst%Vars%y(j)%DL, Mapping%DstDispDL)) ModMap%iVarDstDisp(ModDst%Vars%y(j)%Field) = j + end do + end if + + end select + + ! If no destination variable indices found, cycle + if (all(ModMap%iVarDst == 0)) cycle + if (Mapping%MapType == Map_LoadMesh .and. all(ModMap%iVarDstDisp == 0)) cycle + + ! Add new module mapping to array + ModGlue%VarMaps = [ModGlue%VarMaps, ModMap] + + end associate + end do + + !---------------------------------------------------------------------------- + ! Linearization + !---------------------------------------------------------------------------- + + if (.not. Linearize) return + + ! Allocate linearization arrays + if (ModGlue%Vars%Nx > 0) then + call AllocAry(ModGlue%Lin%x, ModGlue%Vars%Nx, "x", ErrStat2, ErrMsg2) + if (Failed()) return + end if + if (ModGlue%Vars%Nx > 0) then + call AllocAry(ModGlue%Lin%dx, ModGlue%Vars%Nx, "dx", ErrStat2, ErrMsg2) + if (Failed()) return + end if + if (ModGlue%Vars%Nz > 0) then + call AllocAry(ModGlue%Lin%z, ModGlue%Vars%Nz, "z", ErrStat2, ErrMsg2) + if (Failed()) return + end if + if (ModGlue%Vars%Nu > 0) then + call AllocAry(ModGlue%Lin%u, ModGlue%Vars%Nu, "u", ErrStat2, ErrMsg2) + if (Failed()) return + end if + if (ModGlue%Vars%Ny > 0) then + call AllocAry(ModGlue%Lin%y, ModGlue%Vars%Ny, "y", ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! Allocate full Jacobian matrices + if (ModGlue%Vars%Ny > 0 .and. ModGlue%Vars%Nu > 0) then + call AllocAry(ModGlue%Lin%dYdu, ModGlue%Vars%Ny, ModGlue%Vars%Nu, "dYdu", ErrStat2, ErrMsg2) + if (Failed()) return + end if + if (ModGlue%Vars%Nx > 0 .and. ModGlue%Vars%Nu > 0) then + call AllocAry(ModGlue%Lin%dXdu, ModGlue%Vars%Nx, ModGlue%Vars%Nu, "dXdu", ErrStat2, ErrMsg2) + if (Failed()) return + end if + if (ModGlue%Vars%Ny > 0 .and. ModGlue%Vars%Nx > 0) then + call AllocAry(ModGlue%Lin%dYdx, ModGlue%Vars%Ny, ModGlue%Vars%Nx, "dYdx", ErrStat2, ErrMsg2) + if (Failed()) return + end if + if (ModGlue%Vars%Nx > 0 .and. ModGlue%Vars%Nx > 0) then + call AllocAry(ModGlue%Lin%dXdx, ModGlue%Vars%Nx, ModGlue%Vars%Nx, "dXdx", ErrStat2, ErrMsg2) + if (Failed()) return + end if + if (ModGlue%Vars%Nu > 0 .and. ModGlue%Vars%Nu > 0) then + call AllocAry(ModGlue%Lin%dUdu, ModGlue%Vars%Nu, ModGlue%Vars%Nu, "dUdu", ErrStat2, ErrMsg2) + if (Failed()) return + end if + if (ModGlue%Vars%Nu > 0 .and. ModGlue%Vars%Ny > 0) then + call AllocAry(ModGlue%Lin%dUdy, ModGlue%Vars%Nu, ModGlue%Vars%Ny, "dUdy", ErrStat2, ErrMsg2) + if (Failed()) return + end if + +contains + + subroutine CopyVariables(VarAryIn, VarAryOut, iVal) + type(ModVarType), intent(in) :: VarAryIn(:) + type(ModVarType), allocatable, intent(inout) :: VarAryOut(:) + integer(IntKi), intent(inout) :: iVal + + integer(IntKi) :: NumVars, NumVals, iVar + + ! Get number of variables that have flag + NumVars = 0 + do k = 1, size(VarAryIn) + if (MV_HasFlagsAny(VarAryIn(k), FlagFilter)) NumVars = NumVars + 1 + end do + + ! Allocate output array of variables + allocate (VarAryOut(NumVars), stat=ErrStat2) + if (ErrStat2 /= 0) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Failed to allocate vars" + return + end if + + iVar = 1 + + ! Loop through variables in original module + do k = 1, size(VarAryIn) + + ! If variable doesn't have flag, cycle + if (.not. MV_HasFlagsAny(VarAryIn(k), FlagFilter)) cycle + + associate (Var => VarAryOut(iVar)) + + ! Copy variable + Var = VarAryIn(k) + + ! Get number of values in variable + NumVals = VarAryIn(k)%Num + + ! Set value indices in combined module + Var%iGlu = [iVal + 1, iVal + NumVals] + + ! Increment global value index + iVal = iVal + NumVals + + ! Increment variable index in module info variable array + iVar = iVar + 1 + + ! Deallocate linearization names if not doing linearization + if (.not. Linearize .and. allocated(Var%LinNames)) deallocate (Var%LinNames) + + end associate + + end do + + end subroutine + + subroutine AddLinNamePrefix(Var, Prefix) + type(ModVarType), intent(inout) :: Var + character(*), intent(in) :: Prefix + integer(IntKi) :: m + if (allocated(Var%LinNames)) then + do m = 1, size(Var%LinNames) + Var%LinNames(m) = trim(Prefix)//" "//Var%LinNames(m) + end do + end if + end subroutine + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function + + logical function FailedAlloc(name) + character(*), intent(in) :: name + if (ErrStat2 == 0) then + FailedAlloc = .false. + else + call SetErrStat(ErrID_Fatal, "Failed to allocate "//name, ErrStat, ErrMsg, RoutineName) + FailedAlloc = .true. + end if + end function + +end subroutine + +subroutine ModGlue_Init(p, m, y, p_FAST, m_FAST, Turbine, ErrStat, ErrMsg) + type(Glue_ParameterType), intent(inout) :: p !< Glue Parameters + type(Glue_MiscVarType), intent(inout) :: m !< Glue MiscVars + type(Glue_OutputFileType), intent(inout) :: y !< Glue Output + type(FAST_ParameterType), intent(inout) :: p_FAST !< FAST Parameters + type(FAST_MiscVarType), intent(inout) :: m_FAST !< FAST MiscVars + type(FAST_TurbineType), intent(inout) :: Turbine + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'ModGlue_Init' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi), allocatable :: modIDs(:), modIdx(:) + integer(IntKi) :: i, j, k + integer(IntKi) :: LinFlags + + ! Initialize error return + ErrStat = ErrID_None + ErrMsg = "" + + !---------------------------------------------------------------------------- + ! Module order and indexing + !---------------------------------------------------------------------------- + + ! If no modules were added, return error + if (.not. allocated(m%ModData)) then + call SetErrStat(ErrID_Fatal, "No modules were used", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Create array of indices for Mods array + modIdx = [(i, i=1, size(m%ModData))] + + ! Get array of module IDs + modIDs = [(m%ModData(i)%ID, i=1, size(m%ModData))] + + ! Establish module index order for linearization + p%Lin%iMod = [pack(modIdx, ModIDs == Module_IfW), & + pack(modIdx, ModIDs == Module_SeaSt), & + pack(modIdx, ModIDs == Module_SrvD), & + pack(modIdx, ModIDs == Module_ED), & + pack(modIdx, ModIDs == Module_BD), & + pack(modIdx, ModIDs == Module_AD), & + pack(modIdx, ModIDs == Module_HD), & + pack(modIdx, ModIDs == Module_SD), & + pack(modIdx, ModIDs == Module_MAP), & + pack(modIdx, ModIDs == Module_MD)] + + ! Loop through modules, if module is not in index, return with error + if (p_FAST%Linearize) then + do i = 1, size(m%ModData) + if (.not. any(i == p%Lin%iMod)) then + call SetErrStat(ErrID_Fatal, "Module "//trim(m%ModData(i)%Abbr)// & + " not supported in linearization", ErrStat, ErrMsg, RoutineName) + return + end if + end do + end if + + !---------------------------------------------------------------------------- + ! Set Variable Flags for linearization + !---------------------------------------------------------------------------- + + ! Loop through each module by index + do i = 1, size(p%Lin%iMod) + associate (ModData => m%ModData(p%Lin%iMod(i))) + + ! Set linearize flag on all continuous state variables + do j = 1, size(ModData%Vars%x) + call MV_SetFlags(ModData%Vars%x(j), VF_Linearize) + end do + + ! Add or remove linearize flag based on requested input + select case (p_FAST%LinInputs) + case (LIN_NONE) + do j = 1, size(ModData%Vars%u) + call MV_ClearFlags(ModData%Vars%u(j), VF_Linearize) + end do + case (LIN_STANDARD) + ! For standard inputs, use VF_Linearize flag as set in the module + case (LIN_ALL) + do j = 1, size(ModData%Vars%u) + call MV_SetFlags(ModData%Vars%u(j), VF_Linearize) + end do + end select + + ! Add or remove linearize flag based on requested output + select case (p_FAST%LinOutputs) + case (LIN_NONE) + do j = 1, size(ModData%Vars%y) + call MV_ClearFlags(ModData%Vars%y(j), VF_Linearize) + end do + case (LIN_STANDARD) ! Set linearize flag for write output variables + do j = 1, size(ModData%Vars%y) + if (MV_HasFlagsAll(ModData%Vars%y(j), VF_WriteOut)) then + call MV_SetFlags(ModData%Vars%y(j), VF_Linearize) + else + call MV_ClearFlags(ModData%Vars%y(j), VF_Linearize) + end if + end do + case (LIN_ALL) + do j = 1, size(ModData%Vars%y) + call MV_SetFlags(ModData%Vars%y(j), VF_Linearize) + end do + end select + + end associate + end do + + !---------------------------------------------------------------------------- + ! Glue Module + !---------------------------------------------------------------------------- + + LinFlags = VF_Linearize + VF_Mapping + ! LinFlags = VF_None + call Glue_CombineModules(m%ModGlue, m%ModData, m%Mappings, p%Lin%iMod, LinFlags, & + p_FAST%Linearize, ErrStat2, ErrMsg2, Name="Lin") + if (Failed()) return + + !---------------------------------------------------------------------------- + ! Allocate linearization arrays and matrices + !---------------------------------------------------------------------------- + + ! If linearization is enabled + if (p_FAST%Linearize) then + + ! Copy linearization parameters + p%Lin%NumTimes = max(p_FAST%NLinTimes, 2) + p%Lin%InterpOrder = p_FAST%InterpOrder + if (allocated(m_FAST%Lin%LinTimes)) then + y%Lin%Times = m_FAST%Lin%LinTimes + end if + + ! Initialize indices + m%Lin%TimeIndex = 1 + m%Lin%AzimuthIndex = 1 + + ! Set flag to save operating points during linearization if mode shapes requested + p%Lin%SaveOPs = p_FAST%WrVTK == VTK_ModeShapes + + ! Initialize arrays to store operating point states and input + call AllocAry(y%Lin%x, m%ModGlue%Vars%Nx, p%Lin%NumTimes, "Lin%x", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%Lin%z, m%ModGlue%Vars%Nz, p%Lin%NumTimes, "Lin%z", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(y%Lin%u, m%ModGlue%Vars%Nu, p%Lin%NumTimes, "Lin%u", ErrStat2, ErrMsg2); if (Failed()) return + + end if + + ! If linearization and steady state calculation is enabled + if (p_FAST%Linearize .and. p_FAST%CalcSteady) then + + ! Disable saving of OPs during linearization as ModGlue_CalcSteady saves them automatically + p%Lin%SaveOPs = .false. + + ! Initialize variables + m%CS%AzimuthDelta = TwoPi_D/p%Lin%NumTimes + m%CS%NumRotations = 0 + m%CS%IsConverged = .false. + m%CS%FoundSteady = .false. + m%CS%ForceLin = .false. + + ! Calculate number of output values (ignoring write outputs) + m%CS%NumOutputs = 0 + do i = 1, size(m%ModGlue%Vars%y) + associate (Var => m%ModGlue%Vars%y(i)) + if (.not. MV_HasFlagsAll(Var, VF_WriteOut)) m%CS%NumOutputs = m%CS%NumOutputs + Var%Num + end associate + end do + + ! Allocate arrays + call AllocAry(y%Lin%Times, p%Lin%NumTimes, "Lin%Times", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%AzimuthTarget, p%Lin%NumTimes, "CS%AzimuthTarget", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%psi_buffer, p_FAST%LinInterpOrder + 1, "CS%psi_buffer", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%y_buffer, m%ModGlue%Vars%Ny, p_FAST%LinInterpOrder + 1, "CS%y_buffer", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%y_interp, m%ModGlue%Vars%Ny, "CS%y_interp", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%y_diff, m%ModGlue%Vars%Ny, "CS%y_diff", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%y_azimuth, m%ModGlue%Vars%Ny, p%Lin%NumTimes, "CS%y_azimuth", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%CS%y_ref, m%ModGlue%Vars%Ny, "CS%y_ref", ErrStat2, ErrMsg2); if (Failed()) return + + ! Initialize arrays to zero + m%CS%psi_buffer = 0.0_R8Ki + m%CS%y_buffer = 0.0_R8Ki + m%CS%y_interp = 0.0_R8Ki + m%CS%y_diff = 0.0_R8Ki + m%CS%y_azimuth = 0.0_R8Ki + m%CS%y_ref = 1.0_R8Ki + + end if + +contains + + subroutine CalcVarDataLoc(VarAry, DataSize) + type(ModVarType), intent(inout) :: VarAry(:) + integer(IntKi), intent(out) :: DataSize + DataSize = 0 + do i = 1, size(VarAry) + VarAry(i)%iLoc = [DataSize + 1, DataSize + VarAry(i)%Num] + DataSize = DataSize + VarAry(i)%Num + end do + end subroutine + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed + +end subroutine + +subroutine ModGlue_CalcSteady(n_t_global, t_global, p, m, y, p_FAST, m_FAST, T, ErrStat, ErrMsg) + + integer(IntKi), intent(IN) :: n_t_global !< integer time step + real(DbKi), intent(IN) :: t_global !< current simulation time + type(Glue_ParameterType), intent(inout) :: p !< Glue Parameters + type(Glue_MiscVarType), intent(inout) :: m !< Glue MiscVars + type(Glue_OutputFileType), intent(inout) :: y !< Glue Output + type(FAST_ParameterType), intent(inout) :: p_FAST !< FAST Parameters + type(FAST_MiscVarType), intent(inout) :: m_FAST !< FAST MiscVars + type(FAST_TurbineType), intent(inout) :: T !< Turbine Type + integer(IntKi), intent(OUT) :: ErrStat !< Error status of the operation + character(*), intent(OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'ModGlue_CalcSteady' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + real(DbKi) :: DeltaAzimuth, AzimuthTargetDelta, AzimuthTarget + real(DbKi) :: psi !< psi (rotor azimuth) at which the outputs are defined + real(DbKi) :: error + logical :: ProcessAzimuth + integer(IntKi) :: i, j, iy + integer(IntKi), parameter :: iED = 1 + + ErrStat = ErrID_None + ErrMsg = "" + + ! Get current azimuth angle from ElastoDyn output + psi = real(T%ED%y(iED)%LSSTipPxa, R8Ki) + call Zero2TwoPi(psi) + + ! Cyclic shift psi buffer and set first index to new psi + do i = size(m%CS%psi_buffer) - 1, 1, -1 + m%CS%psi_buffer(i + 1) = m%CS%psi_buffer(i) + end do + ! If passing the 2PI boundary, subtract 2PI from saved values so interpolation works correctly + if (psi < m%CS%psi_buffer(1)) m%CS%psi_buffer = m%CS%psi_buffer - TwoPi_D + m%CS%psi_buffer(1) = psi + + ! Cyclic shift output buffer and collect outputs from all modules + do i = size(m%CS%psi_buffer) - 1, 1, -1 + m%CS%y_buffer(:, i + 1) = m%CS%y_buffer(:, i) + end do + + ! Loop through modules and collect output + + do j = 1, size(m%ModGlue%ModData) + associate (ModData => m%ModGlue%ModData(j)) + + ! Skip of module has no outputs + if (size(ModData%Vars%y) == 0) cycle + + ! Get outputs + call FAST_GetOP(ModData, t_global, INPUT_CURR, STATE_CURR, T, ErrStat2, ErrMsg2, & + y_op=m%ModGlue%Lin%y, y_glue=m%ModGlue%Lin%y) + if (Failed()) return + + end associate + end do + + ! Copy outputs to buffer (can't be used directly since it's not allocatable) + m%CS%y_buffer(:, 1) = m%ModGlue%Lin%y + + ! If first call + if (n_t_global == 0) then + + ! Initialize azimuth targets + do i = 1, size(m%CS%AzimuthTarget) + m%CS%AzimuthTarget(i) = (i - 1)*m%CS%AzimuthDelta + psi + call Zero2TwoPi(m%CS%AzimuthTarget(i)) + end do + + ! Initialize psi buffer for interpolation based on time step and rotor speed + do i = 1, size(m%CS%psi_buffer) + m%CS%psi_buffer(i) = psi - (i - 1)*p_FAST%DT*T%ED%y(iED)%LSS_Spd + end do + + ! Initialize output buffer by copying outputs from first buffer location + do i = 2, size(m%CS%y_buffer, 2) + m%CS%y_buffer(:, i) = m%CS%y_buffer(:, 1) + end do + + end if + + ! Calculate change in azimuth from last call, if change is too great, return error + DeltaAzimuth = psi - m%CS%psi_buffer(1) + call Zero2TwoPi(DeltaAzimuth) + if (DeltaAzimuth > m%CS%AzimuthDelta) 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 + + ! Get the current azimuth target + AzimuthTarget = m%CS%AzimuthTarget(m%Lin%AzimuthIndex) + + ! Difference between current azimuth and the target + AzimuthTargetDelta = psi - AzimuthTarget + + ! Set flag to process next azimuth if psi is greater than the next azimuth target + ! and the difference between psi and the target is less than the AzimuthDelta (difference between targets) + ProcessAzimuth = (AzimuthTargetDelta >= 0.0_R8Ki) .and. (AzimuthTargetDelta < m%CS%AzimuthDelta) + + ! If this is the last step, force linearization + if (t_global >= p_FAST%TMax - 0.5_DbKi*p_FAST%DT) then + m%CS%ForceLin = .true. + m%Lin%AzimuthIndex = 1 + ProcessAzimuth = .true. + end if + + ! If flag is set to process azimuth + if (ProcessAzimuth) then + + ! Interpolate outputs to target azimuth + call MV_ExtrapInterp(m%ModGlue%Vars%y, m%CS%y_buffer, m%CS%psi_buffer, & + m%CS%y_interp, AzimuthTarget, ErrStat2, ErrMsg2) + if (Failed()) return + + ! If converged + if (m%CS%IsConverged) then + + ! Calculate error between interpolated outputs and outputs at this + ! azimuth from the previous rotation + error = CalcOutputErrorAtAzimuth() + + ! Update converged flag based on error and tolerance + m%CS%IsConverged = (error < p_FAST%TrimTol) + + end if + + ! Save interpolated outputs for this azimuth + m%CS%y_azimuth(:, m%Lin%AzimuthIndex) = m%CS%y_interp + + ! If linearization is forced + if (m%CS%ForceLin) m%CS%IsConverged = .true. + + ! If converged or in first rotation, save this operating point for linearization later + if (m%CS%IsConverged .or. m%CS%NumRotations == 0) then ! + y%Lin%Times(m%Lin%AzimuthIndex) = t_global + call ModGlue_SaveOperatingPoint(p, m, m%Lin%AzimuthIndex, m%CS%NumRotations == 0, T, ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! Increment the azimuth index counter + m%Lin%AzimuthIndex = m%Lin%AzimuthIndex + 1 + + ! If we've completed one rotor revolution + if (m%Lin%AzimuthIndex > p%Lin%NumTimes) then + + ! Increment number of rotations + m%CS%NumRotations = m%CS%NumRotations + 1 + + ! Save if steady state has been found + m%CS%FoundSteady = m%CS%IsConverged + + ! If steady state has been found, return + if (m%CS%FoundSteady) return + + ! Compute the reference values for this rotor revolution + m%CS%y_ref = max(maxval(m%CS%y_azimuth, dim=2) - minval(m%CS%y_azimuth, dim=2), 0.01_R8Ki) + + ! Check errors next rotor revolution + m%CS%IsConverged = .true. + + ! Reset the azimuth index + m%Lin%AzimuthIndex = 1 + + ! Forcing linearization if time is close to tmax (with sufficient margin) + + ! If rotor has nonzero speed + if (T%ED%p(iED)%RotSpeed > 0) then + + ! If simulation is at least 10 revolutions, and error in rotor speed less than 0.1% + if ((p_FAST%TMax > 10*(TwoPi_D)/T%ED%p(iED)%RotSpeed) .and. & + (t_global >= p_FAST%TMax - 2._DbKi*(TwoPi_D)/T%ED%p(iED)%RotSpeed)) then + if (abs(T%ED%y(iED)%RotSpeed - T%ED%p(iED)%RotSpeed)/T%ED%p(iED)%RotSpeed < 0.001) then + m%CS%ForceLin = .true. + end if + end if + else + if (t_global >= p_FAST%TMax - 1.5_DbKi*p_FAST%DT) then + m%CS%ForceLin = .true. + end if + end if + + end if + end if + + ! If linearization is being forced, set flags and display message + if (m%CS%ForceLin) then + m%CS%IsConverged = .true. + m%CS%FoundSteady = .true. + call WrScr('') + call WrScr('[WARNING] Steady state not found before end of simulation. Forcing linearization.') + end if + +contains + + function CalcOutputErrorAtAzimuth() result(eps_squared) + real(R8Ki) :: eps_squared_sum, eps_squared + + ! Calculate difference between interpolated outputs for this rotation and + ! interpolated outputs from previous rotation + call MV_ComputeDiff(m%ModGlue%Vars%y, m%CS%y_interp, m%CS%y_azimuth(:, m%Lin%AzimuthIndex), m%CS%y_diff) + + ! Initialize epsilon squared sum + eps_squared_sum = 0 + + ! Loop through glue output variables + do i = 1, size(m%ModGlue%Vars%y) + associate (Var => m%ModGlue%Vars%y(i)) + + ! Skip write outputs + if (MV_HasFlagsAll(Var, VF_WriteOut)) cycle + + ! Loop through values in variable + do j = Var%iLoc(1), Var%iLoc(2) + + ! If difference is not essentially zero, sum difference + if (.not. EqualRealNos(m%CS%y_diff(j), 0.0_R8Ki)) then + eps_squared_sum = eps_squared_sum + (m%CS%y_diff(j)/m%CS%y_ref(j))**2 + end if + end do + end associate + end do + + ! Normalize error by number of outputs + eps_squared = eps_squared_sum/m%CS%NumOutputs + end function + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + +subroutine ModGlue_Linearize_OP(p, m, y, p_FAST, m_FAST, y_FAST, t_global, Turbine, ErrStat, ErrMsg) + + type(Glue_ParameterType), intent(inout) :: p !< Glue parameters + type(Glue_MiscVarType), intent(inout) :: m !< Glue MiscVars + type(Glue_OutputFileType), intent(inout) :: y !< Glue Output + type(FAST_ParameterType), intent(in) :: p_FAST + type(FAST_MiscVarType), intent(inout) :: m_FAST + type(FAST_OutputFileType), intent(inout) :: y_FAST + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + real(DbKi), intent(IN) :: t_global !< current (global) simulation time + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'ModGlue_Linearize_OP' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, k + integer(IntKi) :: ix, iz, iu, iy + integer(IntKi) :: Un + integer(IntKi) :: StateLinIndex, InputLinIndex + integer(IntKi), parameter :: iED = 1 + character(200) :: SimStr + character(MaxWrScrLen) :: BlankLine + character(1024) :: LinRootName + character(*), parameter :: Fmt = 'F10.2' + + ! Initialize error return + ErrStat = ErrID_None + ErrMsg = "" + + ! Write message to screen + BlankLine = "" + call WrOver(BlankLine) ! BlankLine contains MaxWrScrLen spaces + SimStr = '(RotSpeed='//trim(Num2LStr(Turbine%ED%y(iED)%RotSpeed*RPS2RPM, Fmt))//' rpm, BldPitch1='//trim(Num2LStr(Turbine%ED%y(iED)%BlPitch(1)*R2D, Fmt))//' deg)' + call WrOver(' Performing linearization '//trim(Num2LStr(m%Lin%TimeIndex))//' at simulation time '//TRIM(Num2LStr(t_global))//' s. '//trim(SimStr)) + call WrScr('') + + !---------------------------------------------------------------------------- + ! Save operating point + !---------------------------------------------------------------------------- + + ! If flag set to save operating points during linearization + if (p%Lin%SaveOPs) then + call ModGlue_SaveOperatingPoint(p, m, m%Lin%TimeIndex, .true., Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end if + + !---------------------------------------------------------------------------- + ! Initialization + !---------------------------------------------------------------------------- + + ! Get parameters + y_FAST%Lin%RotSpeed = Turbine%ED%y(iED)%RotSpeed + y_FAST%Lin%Azimuth = Turbine%ED%y(iED)%LSSTipPxa + + ! Assemble linearization root file name + LinRootName = trim(p_FAST%OutFileRoot)//'.'//trim(Num2LStr(m%Lin%TimeIndex)) + + ! Get unit number for writing files + call GetNewUnit(Un, ErrStat2, ErrMsg2); if (Failed()) return + + ! Initialize the index numbers + ix = 1 + iz = 1 + iu = 1 + iy = 1 + + ! Initialize data in Jacobian matrices to zero + if (allocated(m%ModGlue%Lin%dYdu)) m%ModGlue%Lin%dYdu = 0.0_R8Ki + if (allocated(m%ModGlue%Lin%dXdu)) m%ModGlue%Lin%dXdu = 0.0_R8Ki + if (allocated(m%ModGlue%Lin%dYdx)) m%ModGlue%Lin%dYdx = 0.0_R8Ki + if (allocated(m%ModGlue%Lin%dXdx)) m%ModGlue%Lin%dXdx = 0.0_R8Ki + + ! Loop through linearization modules by index + do i = 1, size(m%ModGlue%ModData) + associate (ModData => m%ModGlue%ModData(i)) + + ! Derivatives with respect to input + call FAST_JacobianPInput(ModData, t_global, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + dYdu=ModData%Lin%dYdu, dYdu_glue=m%ModGlue%Lin%dYdu, & + dXdu=ModData%Lin%dXdu, dXdu_glue=m%ModGlue%Lin%dXdu) + if (Failed()) return + + ! Derivatives with respect to continuous state + call FAST_JacobianPContState(ModData, t_global, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + dYdx=ModData%Lin%dYdx, dYdx_glue=m%ModGlue%Lin%dYdx, & + dXdx=ModData%Lin%dXdx, dXdx_glue=m%ModGlue%Lin%dXdx) + if (Failed()) return + + ! Operating point values (must come after Jacobian routines because + ! some modules calculate OP in those routines [MD]) + call FAST_GetOP(ModData, t_global, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + u_op=ModData%Lin%u, u_glue=m%ModGlue%Lin%u, & + y_op=ModData%Lin%y, y_glue=m%ModGlue%Lin%y, & + x_op=ModData%Lin%x, x_glue=m%ModGlue%Lin%x, & + dx_op=ModData%Lin%dx, dx_glue=m%ModGlue%Lin%dx) + if (Failed()) return + + ! If requested, write the module linearization matrices was requested + if (p_FAST%LinOutMod) then + call CalcWriteLinearMatrices(ModData%Vars, ModData%Lin, p_FAST, y_FAST, t_global, Un, & + LinRootName, VF_Linearize, ErrStat2, ErrMsg2, ModSuffix=ModData%Abbr) + if (Failed()) return + end if + + end associate + end do + + ! Copy arrays into linearization operating points + if (allocated(m%ModGlue%Lin%x)) y%Lin%x(:, m%Lin%TimeIndex) = m%ModGlue%Lin%x + if (allocated(m%ModGlue%Lin%z)) y%Lin%z(:, m%Lin%TimeIndex) = m%ModGlue%Lin%z + if (allocated(m%ModGlue%Lin%u)) y%Lin%u(:, m%Lin%TimeIndex) = m%ModGlue%Lin%u + + ! Linearize mesh mappings to populate dUdy and dUdu + call FAST_LinearizeMappings(m%ModGlue, m%Mappings, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Write glue code matrices to file + call CalcWriteLinearMatrices(m%ModGlue%Vars, m%ModGlue%Lin, p_FAST, y_FAST, t_global, Un, LinRootName, VF_Linearize, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Update index for next linearization time + m%Lin%TimeIndex = m%Lin%TimeIndex + 1 + +contains + logical function JacobianHasNaNs(Jac, label, abbr) + real(R8Ki), allocatable, intent(in) :: Jac(:, :) + character(*), intent(in) :: label, abbr + JacobianHasNaNs = .false. + if (.not. allocated(Jac)) return + if (size(Jac) == 0) return + if (.not. any(isnan(Jac))) return + ErrStat = ErrID_Fatal + ErrMsg = 'NaNs detected in dXdx for module '//abbr + JacobianHasNaNs = .true. + end function + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + +subroutine ModGlue_SaveOperatingPoint(p, m, OPIndex, NewCopy, Turbine, ErrStat, ErrMsg) + type(Glue_ParameterType), intent(in) :: p + type(Glue_MiscVarType), intent(inout) :: m + integer(IntKi), intent(in) :: OPIndex + logical, intent(in) :: NewCopy + type(FAST_TurbineType), intent(inout) :: Turbine + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'ModGlue_SaveOperatingPoint' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: StateIndex, InputIndex, CtrlCode, i + + ErrStat = ErrID_None + ErrMsg = '' + + ! Set CtrlCode based on NewCopy flag + if (NewCopy) then + CtrlCode = MESH_NEWCOPY + else + CtrlCode = MESH_UPDATECOPY + end if + + ! Index into state array where linearization data will be stored for this OP + StateIndex = NumStateTimes + OPIndex + + ! Index into input save array where linearization data will be stored for OP + InputIndex = Turbine%p_FAST%InterpOrder + 1 + OPIndex + + ! Loop through modules by index + do i = 1, size(p%Lin%iMod) + associate (ModData => m%ModData(p%Lin%iMod(i))) + + ! Copy current module state to linearization save location + call FAST_CopyStates(ModData, Turbine, STATE_CURR, StateIndex, CtrlCode, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Copy current module output to linearization save location + call FAST_CopyInput(ModData, Turbine, INPUT_CURR, -InputIndex, CtrlCode, ErrStat2, ErrMsg2) + if (Failed()) return + + end associate + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + +subroutine ModGlue_RestoreOperatingPoint(p, m, OPIndex, Turbine, ErrStat, ErrMsg) + type(Glue_ParameterType), intent(in) :: p + type(Glue_MiscVarType), intent(inout) :: m + integer(IntKi), intent(in) :: OPIndex + type(FAST_TurbineType), intent(inout) :: Turbine + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'ModGlue_RestoreOperatingPoint' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: StateIndex, InputIndex, i + + ErrStat = ErrID_None + ErrMsg = '' + + ! Index into state array where linearization data will be stored for this OP + StateIndex = NumStateTimes + OPIndex + + ! Index into input save array where linearization data will be stored for OP + InputIndex = -(Turbine%p_FAST%InterpOrder + 1 + OPIndex) + + ! Loop through modules by index + do i = 1, size(p%Lin%iMod) + associate (ModData => m%ModData(p%Lin%iMod(i))) + + ! Copy current module state to linearization save location + call FAST_CopyStates(ModData, Turbine, StateIndex, STATE_CURR, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Copy current module input to linearization save location + call FAST_CopyInput(ModData, Turbine, InputIndex, INPUT_CURR, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + end associate + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + +!> CalcGlueStateMatrices forms the full-system state matrices for linearization: A, B, C, and D. +!! Note that it uses LAPACK_GEMM instead of MATMUL for matrix multiplications because of stack-space issues (these +!! matrices get large quickly). +subroutine CalcGlueStateMatrices(Vars, Lin, JacScaleFactor, ErrStat, ErrMsg) + type(ModVarsType), intent(in) :: Vars !< Glue variable data + type(ModLinType), intent(inout) :: Lin !< Glue linearization data + real(R8Ki), intent(in) :: JacScaleFactor !< Scale factor for conditioning the Jacobians + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'CalcGlueStateMatrices' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + real(R8Ki), allocatable :: G(:, :), tmp(:, :) + integer(IntKi), allocatable :: ipiv(:) + + if (.not. allocated(Lin%dUdu)) return + + ! A = dXdx + ! B = dXdu + ! C = dYdx + ! D = dYdu + + ! call DumpMatrix(1000, "dUdu.bin", Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(1000, "dUdy.bin", Lin%dUdy, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(1000, "A.bin", Lin%dXdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(1000, "B.bin", Lin%dXdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(1000, "C.bin", Lin%dYdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(1000, "D.bin", Lin%dYdu, ErrStat2, ErrMsg2); if (Failed()) return + + ! *** get G matrix **** + !---------------------- + call AllocAry(G, size(Lin%dUdu, 1), size(Lin%dUdu, 2), 'G', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(ipiv, Vars%Nu, 'ipiv', ErrStat2, ErrMsg2); if (Failed()) return + + ! G = dUdu + matmul(dUdy, y_FAST%Lin%Glue%D) + G = Lin%dUdu + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, Lin%dUdy, Lin%dYdu, 1.0_R8Ki, G, ErrStat2, ErrMsg2); if (Failed()) return + + ! G can be ill-conditioned, so we are going to precondition with G_hat = S^(-1) * G * S + ! we will also multiply the right-hand-side of the equations that need G inverse so that + ! dUdy_hat = S^(-1)*dUdy and dUdu_hat = S^(-1)*dUdu + call Precondition(Vars%u, G, Lin%dUdu, Lin%dUdy, JacScaleFactor) + + ! Form G_hat^(-1) * (S^-1*dUdy) and G^(-1) * (S^-1*dUdu) + ! factor G for the two solves: + call LAPACK_getrf(M=size(G, 1), N=size(G, 2), A=G, IPIV=ipiv, ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + + ! after the this solve, dUdy holds G_hat^(-1) * dUdy_hat: + call LAPACK_getrs(trans='N', N=size(G, 2), A=G, IPIV=ipiv, B=Lin%dUdy, ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + + ! after the this solve, dUdu holds G_hat^(-1) * dUdu_hat: + call LAPACK_getrs(trans='N', N=size(G, 2), A=G, IPIV=ipiv, B=Lin%dUdu, ErrStat=ErrStat2, ErrMsg=ErrMsg2); if (Failed()) return + + ! Deallocate G and ipiv because the solves are complete + deallocate (G) + deallocate (ipiv) + + ! After this call, dUdu holds G^(-1)*dUdu and dUdy holds G^(-1)*dUdy + call Postcondition(Vars%u, Lin%dUdu, Lin%dUdy, JacScaleFactor) + + ! Allocate tmp matrix for A and C calculations + call AllocAry(tmp, Vars%Nu, Vars%Nx, 'G^-1*dUdy*C', ErrStat2, ErrMsg2); if (Failed()) return + + ! tmp = G^(-1) * dUdy * diag(C) + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, Lin%dUdy, Lin%dYdx, 0.0_R8Ki, tmp, ErrStat2, ErrMsg2); if (Failed()) return + + ! A + ! dXdx = dXdx - matmul(dXdu, tmp) + call LAPACK_GEMM('N', 'N', -1.0_R8Ki, Lin%dXdu, tmp, 1.0_R8Ki, Lin%dXdx, ErrStat2, ErrMsg2); if (Failed()) return + + ! C + ! dYdx = dYdx - matmul(dYdu, tmp) + call LAPACK_GEMM('N', 'N', -1.0_R8Ki, Lin%dYdu, tmp, 1.0_R8Ki, Lin%dYdx, ErrStat2, ErrMsg2); if (Failed()) return + + ! B + tmp = Lin%dXdu + ! dXdu = matmul(dXdu, dUdu) + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, tmp, Lin%dUdu, 0.0_R8Ki, Lin%dXdu, ErrStat2, ErrMsg2); if (Failed()) return + + ! D + tmp = Lin%dYdu + ! D = matmul(dYdu, dUdu) + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, tmp, Lin%dUdu, 0.0_R8Ki, Lin%dYdu, ErrStat2, ErrMsg2); if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + +!> Precondition returns the preconditioned matrix, hat{G}, such that hat{G} = S^(-1) G S withS^(-1 defined +!! such that loads are scaled by p_FAST%UJacSclFact. It also returns the preconditioned matrices hat{dUdu} and +!! hat{dUdy} such that hat{dUdu} = S^(-1) dUdu and +!! hat{dUdy} = S^(-1) dUdy for the right-hand sides of the equations to be solved. +subroutine Precondition(uVars, G, dUdu, dUdy, JacScaleFactor) + type(ModVarType), intent(in) :: uVars(:) !< Input variables from glue code + real(R8Ki), intent(inout) :: G(:, :) !< variable for glue-code linearization (in is G; out is G_hat) + real(R8Ki), intent(inout) :: dUdu(:, :) !< jacobian in FAST linearization from right-hand-side of equation + real(R8Ki), intent(inout) :: dUdy(:, :) !< jacobian in FAST linearization from right-hand-side of equation + real(R8Ki), intent(in) :: JacScaleFactor !< jacobian scale factor + real(R8Ki), allocatable :: diag(:) !< diagonal elements of G + integer(IntKi) :: LoadFlags + integer(IntKi) :: i, j, k + logical :: isRowLoad, isColLoad + logical, allocatable :: isLoad(:) + + allocate (isLoad(size(dUdu, 1))) + isLoad = .false. + + ! Loop through glue code input variables (cols) + do i = 1, size(uVars) + + ! Get if col variable is a load + isColLoad = MV_IsLoad(uVars(i)) + + ! Get col variable start and end indices in matrix + associate (iLoc => uVars(i)%iLoc) + + isLoad(iLoc(1):iLoc(2)) = isColLoad + + ! Loop through glue code input variables (rows) + do j = 1, size(uVars) + + ! Get if row variable is a load + isRowLoad = MV_IsLoad(uVars(j)) + + ! Get row variable start and end indices in matrix + associate (jLoc => uVars(j)%iLoc) + + if (isColLoad .and. (.not. isRowLoad)) then + + ! Multiply columns of G + G(jLoc(1):jLoc(2), iLoc(1):iLoc(2)) = G(jLoc(1):jLoc(2), iLoc(1):iLoc(2))*JacScaleFactor + + else if (isRowLoad .and. (.not. isColLoad)) then + + ! Divide rows of G + G(jLoc(1):jLoc(2), iLoc(1):iLoc(2)) = G(jLoc(1):jLoc(2), iLoc(1):iLoc(2))/JacScaleFactor + + end if + + end associate + + end do + + ! Divide rows of dUdu and dUdy by scale factor + if (isColLoad) then + dUdu(iLoc(1):iLoc(2), :) = dUdu(iLoc(1):iLoc(2), :)/JacScaleFactor + dUdy(iLoc(1):iLoc(2), :) = dUdy(iLoc(1):iLoc(2), :)/JacScaleFactor + end if + + end associate + + end do + +end subroutine + +!> This routine returns the matrices tilde{dUdu} and tilde{dUdy} such that +!! tilde{dUdu} = G^(-1) dUdu and +!! tilde{dUdy} = G^(-1) dUdy, which have been solved using the preconditioned system defined in fast_lin::precondition. +subroutine Postcondition(uVars, dUdu, dUdy, JacScaleFactor) + type(ModVarType), intent(in) :: uVars(:) !< Input variables from glue code + real(R8Ki), intent(in) :: JacScaleFactor !< jacobian scale factor + real(R8Ki), intent(inout) :: dUdu(:, :) !< jacobian in FAST linearization from right-hand-side of equation + real(R8Ki), intent(inout) :: dUdy(:, :) !< jacobian in FAST linearization from right-hand-side of equation + integer(IntKi) :: i + + ! Loop through glue code input varies + do i = 1, size(uVars) + + ! If variable is a (force or moment), apply post-conditioner + if (uVars(i)%Field == FieldForce .or. uVars(i)%Field == FieldMoment) then + + ! Otherwise get variable start and end indices in matrix + associate (iLoc => uVars(i)%iLoc) + + ! Multiply rows of dUdu + dUdu(iLoc(1):iLoc(2), :) = dUdu(iLoc(1):iLoc(2), :)*JacScaleFactor + + ! Multiply rows of dUdy + dUdy(iLoc(1):iLoc(2), :) = dUdy(iLoc(1):iLoc(2), :)*JacScaleFactor + + end associate + + end if + end do + +end subroutine + +subroutine CalcWriteLinearMatrices(Vars, Lin, p_FAST, y_FAST, t_global, Un, LinRootName, FilterFlag, ErrStat, ErrMsg, ModSuffix, CalcGlue, FullOutput) + type(ModVarsType), intent(in) :: Vars !< Variable data + type(ModLinType), intent(inout) :: Lin !< Linearization data + type(FAST_ParameterType), intent(in) :: p_FAST !< Parameters + type(FAST_OutputFileType), intent(in) :: y_FAST !< Output variables + real(DbKi), intent(in) :: t_global !< current time step (written in file) + integer(IntKi), intent(in) :: Un !< Unit number for file + character(*), intent(in) :: LinRootName !< output file name + integer(IntKi), intent(in) :: FilterFlag !< Variable flag for filtering + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + character(*), optional, intent(in) :: ModSuffix !< Module suffix for file name + logical, optional, intent(in) :: CalcGlue !< Flag to calculate glue state matrices + logical, optional, intent(in) :: FullOutput !< Flag to output all Jacobians + + character(*), parameter :: RoutineName = 'WriteModuleLinearMatrices' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(32) :: Desc + character(1024) :: OutFileName + integer(IntKi) :: i + integer(IntKi) :: Nx, Nxd, Nz, Nu, Ny + character(50) :: Fmt + logical, allocatable :: uUse(:), yUse(:), xUse(:) + logical :: CalcGlueLoc, FullOutputLoc + + ErrStat = ErrID_None + ErrMsg = "" + + ! Assemble output file name based on glue linearization abbreviation + if (present(ModSuffix)) then + OutFileName = trim(LinRootName)//"."//trim(ModSuffix)//".lin" + CalcGlueLoc = .false. + else + OutFileName = trim(LinRootName)//".lin" + CalcGlueLoc = .true. + end if + + if (present(FullOutput)) then + FullOutputLoc = FullOutput + else + FullOutputLoc = p_FAST%LinOutJac + end if + + ! Set flag to calculate glue matrices based on optional parameter + if (present(CalcGlue)) CalcGlueLoc = CalcGlue + + ! Open linearization file + call OpenFOutFile(Un, OutFileName, ErrStat2, ErrMsg2); if (Failed()) return + + ! Calculate number of values in variable after applying filter + Nx = MV_NumVals(Vars%x, FilterFlag) + Nxd = 0 + Nz = MV_NumVals(Vars%z, FilterFlag) + Nu = MV_NumVals(Vars%u, FilterFlag) + Ny = MV_NumVals(Vars%y, FilterFlag) + + !---------------------------------------------------------------------------- + ! Header + !---------------------------------------------------------------------------- + + write (Un, '(/,A)') 'Linearized model: '//trim(y_FAST%FileDescLines(1)) + write (Un, '(1X,A,/)') trim(y_FAST%FileDescLines(2)) + write (Un, '(A,/)') trim(y_FAST%FileDescLines(3)) + + write (Un, '(A)') 'Simulation information:' + + fmt = '(3x,A,1x,'//trim(p_FAST%OutFmt_t)//',1x,A)' + 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)' + Desc = 'Number of continuous states: '; write (Un, fmt) Desc, Nx + Desc = 'Number of discrete states: '; write (Un, fmt) Desc, Nxd + Desc = 'Number of constraint states: '; write (Un, fmt) Desc, Nz + Desc = 'Number of inputs: '; write (Un, fmt) Desc, Nu + Desc = 'Number of outputs: '; write (Un, fmt) Desc, Ny + + Desc = 'Jacobians included in this file?' + fmt = '(3x,A,1x,A5)' + if (p_FAST%LinOutJac) then + write (Un, fmt) Desc, 'Yes' + else + write (Un, fmt) Desc, 'No' + end if + + write (Un, '()') !print a blank line + + if (Nx > 0 .and. allocated(Lin%x)) then + write (Un, '(A)') 'Order of continuous states:' + call WrLinFile_txt_Table(Vars%x, FilterFlag, p_FAST, Un, "Row/Column", Lin%x) + end if + + if (Nx > 0 .and. allocated(Lin%dx)) then + write (Un, '(A)') 'Order of continuous state derivatives:' + call WrLinFile_txt_Table(Vars%x, FilterFlag, p_FAST, Un, "Row/Column", Lin%dx, IsDeriv=.true.) + end if + + if (Nz > 0 .and. allocated(Lin%z)) then + write (Un, '(A)') 'Order of constraint states:' + call WrLinFile_txt_Table(Vars%z, FilterFlag, p_FAST, Un, "Row/Column", Lin%z) + end if + + if (Nu > 0 .and. allocated(Lin%u)) then + write (Un, '(A)') 'Order of inputs:' + call WrLinFile_txt_Table(Vars%u, FilterFlag, p_FAST, Un, "Column ", Lin%u, ShowRot=.true.) + end if + + if (Ny > 0 .and. allocated(Lin%y)) then + write (Un, '(A)') 'Order of outputs:' + call WrLinFile_txt_Table(Vars%y, FilterFlag, p_FAST, Un, "Row ", Lin%y, ShowRot=.true.) + end if + + ! Create boolean array indicating which continuous state values to write + allocate (xUse(Vars%Nx)) + xUse = .false. + do i = 1, size(Vars%x) + associate (Var => Vars%x(i)) + if (MV_HasFlagsAll(Var, FilterFlag)) xUse(Var%iLoc(1):Var%iLoc(2)) = .true. + end associate + end do + + ! Create boolean array indicating which input values to write + allocate (uUse(Vars%Nu)) + uUse = .false. + do i = 1, size(Vars%u) + associate (Var => Vars%u(i)) + if (MV_HasFlagsAll(Var, FilterFlag)) uUse(Var%iLoc(1):Var%iLoc(2)) = .true. + end associate + end do + + ! Create boolean array indicating which output values to write + allocate (yUse(Vars%Ny)) + yUse = .false. + do i = 1, size(Vars%y) + associate (Var => Vars%y(i)) + if (MV_HasFlagsAll(Var, FilterFlag)) yUse(Var%iLoc(1):Var%iLoc(2)) = .true. + end associate + end do + + ! If Jacobian matrix output is requested + if (FullOutputLoc) then + write (Un, '(/,A,/)') 'Jacobian matrices:' + if (allocated(Lin%dUdu)) call WrPartialMatrix(Lin%dUdu, Un, p_FAST%OutFmt, 'dUdu', UseRow=uUse, UseCol=uUse) + if (allocated(Lin%dUdy)) call WrPartialMatrix(Lin%dUdy, Un, p_FAST%OutFmt, 'dUdy', UseRow=uUse, UseCol=yUse) + if (allocated(Lin%dXdy)) call WrPartialMatrix(Lin%dXdy, Un, p_FAST%OutFmt, 'dXdy', UseRow=xUse, UseCol=yUse) + if (allocated(Lin%J)) call WrPartialMatrix(Lin%J, Un, p_FAST%OutFmt, 'J') + if (present(ModSuffix)) then + if (allocated(Lin%dXdx)) call WrPartialMatrix(Lin%dXdx, Un, p_FAST%OutFmt, 'dXdx', UseRow=xUse, UseCol=xUse) + if (allocated(Lin%dXdu)) call WrPartialMatrix(Lin%dXdu, Un, p_FAST%OutFmt, 'dXdu', UseRow=xUse, UseCol=uUse) + if (allocated(Lin%dYdx)) call WrPartialMatrix(Lin%dYdx, Un, p_FAST%OutFmt, 'dYdx', UseRow=yUse, UseCol=xUse) + if (allocated(Lin%dYdu)) call WrPartialMatrix(Lin%dYdu, Un, p_FAST%OutFmt, 'dYdu', UseRow=yUse, UseCol=uUse) + end if + end if + + ! If this is glue code module, calculate the glue code state matrices (A, B, C, D) + ! Called here, after writing dUdu and dUdy, because those matrices are overwritten + ! in the process of calculating the other state matrices + if (CalcGlueLoc) then + call CalcGlueStateMatrices(Vars, Lin, real(p_FAST%UJacSclFact, R8Ki), ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! Write the linearized state matrices + write (Un, '(/,A,/)') 'Linearized state matrices:' + if (allocated(Lin%dXdx)) call WrPartialMatrix(Lin%dXdx, Un, p_FAST%OutFmt, 'A', UseRow=xUse, UseCol=xUse) + if (allocated(Lin%dXdu)) call WrPartialMatrix(Lin%dXdu, Un, p_FAST%OutFmt, 'B', UseRow=xUse, UseCol=uUse) + if (allocated(Lin%dYdx)) call WrPartialMatrix(Lin%dYdx, Un, p_FAST%OutFmt, 'C', UseRow=yUse, UseCol=xUse) + if (allocated(Lin%dYdu)) call WrPartialMatrix(Lin%dYdu, Un, p_FAST%OutFmt, 'D', UseRow=yUse, UseCol=uUse) + if (allocated(Lin%StateRotation)) call WrPartialMatrix(Lin%StateRotation, Un, p_FAST%OutFmt, 'StateRotation') + + ! Close file + close (Un) + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) close (Un) + end function Failed +end subroutine CalcWriteLinearMatrices + +subroutine WrLinFile_txt_Table(VarAry, FlagFilter, p_FAST, Un, RowCol, op, IsDeriv, ShowRot) + + type(ModVarType), intent(in) :: VarAry(:) !< variable array + integer(IntKi), intent(in) :: FlagFilter !< unit number + type(FAST_ParameterType) :: p_FAST !< Parameters + integer(IntKi), intent(in) :: Un !< unit number + character(*), intent(in) :: RowCol !< Row/Column description + real(R8Ki), intent(in) :: op(:) !< operating point values (possibly different size that Desc because of orientations) + logical, optional, intent(in) :: IsDeriv !< flag that tells us if we need to modify the channel names for derivatives (xdot) + logical, optional, intent(in) :: ShowRot !< flag to show rotation matrix if field is orientation + + character(*), parameter :: RoutineName = 'WrLinFile_txt_Table' + integer(IntKi) :: TS ! Tab stop column + integer(IntKi) :: i_op ! Index of value in operating piont + logical :: IsDerivLoc ! flag that tells us if we need to modify the channel names for derivatives (xdot) + logical :: VarRotFrame ! flag that tells us if this column is in the rotating frame + integer(IntKi) :: VarDerivOrder ! integer indicating the maximum time-derivative order of a channel (this will be 0 for anything that is not a continuous state) + character(100) :: Fmt, FmtStr, FmtRot + character(25) :: DerivStr, DerivUnitStr + logical :: ShowRotLoc + real(R8Ki) :: DCM(3, 3), wm(3) + integer(IntKi) :: i, j, RowColIdx + + ShowRotLoc = .false. + if (present(ShowRot)) ShowRotLoc = ShowRot + + IsDerivLoc = .false. + if (present(IsDeriv)) IsDerivLoc = IsDeriv + + if (IsDerivLoc) then + if (p_FAST%CompAeroMaps .and. p_FAST%CompElast /= MODULE_BD) then ! this might not work if we are using some other (not BD, ED) module with states + DerivStr = 'Second time derivative of' + DerivUnitStr = '/s^2' + else + DerivStr = 'First time derivative of' + DerivUnitStr = '/s' + end if + else + DerivStr = '' + DerivUnitStr = '' + end if + + ! tab stop after operating point + TS = 14 + 3*p_FAST%FmtWidth + 7 + + ! Construct write formats + Fmt = '(3x,I8,3x,'//trim(p_FAST%OutFmt)//',T'//trim(Num2LStr(TS))//',L8,8x,I8,9x,A)' + FmtRot = '(3x,I8,3x,'//trim(p_FAST%OutFmt)//',2(", ",'//trim(p_FAST%OutFmt)//'),T'//trim(Num2LStr(TS))//',L8,8x,I8,9x,A)' + FmtStr = '(3x,A10,1x,A,T'//trim(Num2LStr(TS))//',A15,1x,A16,1x,A)' + + ! Write header + write (Un, FmtStr) RowCol, 'Operating Point', 'Rotating Frame?', 'Derivative Order', 'Description' + write (Un, FmtStr) '----------', '---------------', '---------------', '----------------', '-----------' + + ! Loop through variables in array + RowColIdx = 0 + do i = 1, size(VarAry) + associate (Var => VarAry(i)) + + ! If variable does not have the filter flag, continue + if (.not. MV_HasFlagsAll(Var, FlagFilter)) cycle + + ! Is variable in the rotating frame? + VarRotFrame = MV_HasFlagsAll(Var, VF_RotFrame) + + ! Get variable derivative order + if (MV_HasFlagsAll(Var, VF_DerivOrder2)) then + VarDerivOrder = 2 + else if (MV_HasFlagsAll(Var, VF_DerivOrder1)) then + VarDerivOrder = 1 + else + VarDerivOrder = 0 + end if + + ! Loop through values in variable + do j = 1, Var%Num + + ! Increment value counter + RowColIdx = RowColIdx + 1 + + ! Index in operating point array + i_op = Var%iLoc(1) + j - 1 + + ! If variable is orientation and show rotation matrix flag is true + if (ShowRotLoc .and. (Var%Field == FieldOrientation)) then + + ! Skip writing if not the first value in orientation (3 values) + if (mod(j - 1, 3) /= 0) cycle + + ! Convert quaternion parameters to DCM + DCM = quat_to_dcm(real(op(i_op:i_op + 2), R8Ki)) + + ! Write 3 rows of data (full dcm) + write (Un, FmtRot) RowColIdx + 0, dcm(1, 1), dcm(1, 2), dcm(1, 3), VarRotFrame, VarDerivOrder, trim(Var%LinNames(j + 0)) + write (Un, FmtRot) RowColIdx + 1, dcm(2, 1), dcm(2, 2), dcm(2, 3), VarRotFrame, VarDerivOrder, trim(Var%LinNames(j + 1)) + write (Un, FmtRot) RowColIdx + 2, dcm(3, 1), dcm(3, 2), dcm(3, 3), VarRotFrame, VarDerivOrder, trim(Var%LinNames(j + 2)) + + else if (IsDerivLoc) then + + write (Un, Fmt) RowColIdx, op(i_op), VarRotFrame, VarDerivOrder, trim(DerivStr)//' '//trim(Var%LinNames(j))//trim(DerivUnitStr) + + else if (MV_HasFlagsAll(Var, VF_WM_Rot)) then ! BeamDyn Wiener-Milenkovic orientation + + ! Skip writing if not the first value in orientation (3 values) + if (mod(j - 1, 3) /= 0) cycle + + ! Convert from quaternion in operating point to BeamDyn WM parameter + wm = -quat_to_wm(op(i_op:i_op + 2)) + + ! Write all components of WM parameters + write (Un, Fmt) RowColIdx, wm(1), VarRotFrame, VarDerivOrder, trim(Var%LinNames(j)) + write (Un, Fmt) RowColIdx, wm(2), VarRotFrame, VarDerivOrder, trim(Var%LinNames(j)) + write (Un, Fmt) RowColIdx, wm(3), VarRotFrame, VarDerivOrder, trim(Var%LinNames(j)) + + else + + write (Un, Fmt) RowColIdx, op(i_op), VarRotFrame, VarDerivOrder, trim(Var%LinNames(j)) + + end if + + end do + end associate + end do + + write (Un, '()') !print a blank line + +end subroutine WrLinFile_txt_Table + +end module diff --git a/modules/openfast-library/src/FAST_Mods.f90 b/modules/openfast-library/src/FAST_Mods.f90 index a09e8f43d5..62c9b8697b 100644 --- a/modules/openfast-library/src/FAST_Mods.f90 +++ b/modules/openfast-library/src/FAST_Mods.f90 @@ -40,6 +40,11 @@ MODULE FAST_ModTypes INTEGER(IntKi), PARAMETER :: STATE_SAVED_CURR = 3 INTEGER(IntKi), PARAMETER :: STATE_SAVED_PRED = 4 + ! input array indices + INTEGER(IntKi), PARAMETER :: INPUT_TEMP = 0 + INTEGER(IntKi), PARAMETER :: INPUT_CURR = 1 + INTEGER(IntKi), PARAMETER :: INPUT_PREV = 2 + ! VTK visualization INTEGER(IntKi), PARAMETER :: VTK_Unknown = -1 !< unknown option (will produce error) INTEGER(IntKi), PARAMETER :: VTK_None = 0 !< none (no VTK output) @@ -70,7 +75,6 @@ MODULE FAST_ModTypes LOGICAL, PARAMETER :: BD_Solve_Option1 = .TRUE. - END MODULE FAST_ModTypes !======================================================================= diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 2cbaa53e41..2d83f23c4a 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -11,6 +11,7 @@ ################################################################################################################################### # ...... Include files (definitions from NWTC Library and module components) ............................................................................ include Registry_NWTC_Library.txt +usefrom Glue_Registry.txt usefrom ElastoDyn_Registry.txt usefrom SED_Registry.txt usefrom Registry_BeamDyn.txt @@ -123,6 +124,10 @@ typedef ^ FAST_ParameterType IntKi numIceLegs - - - "number of suport-structure typedef ^ FAST_ParameterType IntKi nBeams - - - "number of BeamDyn instances" - typedef ^ FAST_ParameterType LOGICAL BD_OutputSibling - - - "flag to determine if BD input is sibling of output mesh" - typedef ^ FAST_ParameterType LOGICAL ModuleInitialized {NumModules} - - "An array determining if the module has been initialized" - +# Data for TC Solver: +typedef ^ FAST_ParameterType DbKi RhoInf - - - "Numerical damping parameter for tight coupling generalized-alpha integrator (-) [0.0 to 1.0]" - +typedef ^ FAST_ParameterType DbKi ConvTol - - - "Convergence iteration error tolerance for tight coupling generalized alpha integrator (-)" - +typedef ^ FAST_ParameterType IntKi MaxConvIter - - - "Maximum number of convergence iterations for tight coupling generalized alpha integrator (-)" - # Data for Jacobians: typedef ^ FAST_ParameterType DbKi DT_Ujac - - - "Time between when we need to re-calculate these Jacobians" s typedef ^ FAST_ParameterType Reki UJacSclFact - - - "Scaling factor used to get similar magnitudes between accelerations, forces, and moments in Jacobians" - @@ -230,95 +235,6 @@ typedef ^ FAST_ParameterType ReKi Pitch {:} - - "List of pitch angles for aeroma typedef ^ FAST_ParameterType IntKi GearBox_index - - - "Index to gearbox rotation in state array (for steady-state calculations)" - -# 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" -# ..... No Simplified-ElastoDyn data ........................................................................................... -# ..... 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" -# ..... 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" -# ..... No AeroDisk data ...................................................................................................... -# ..... 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 ExternalInflow 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" -# ..... SeaSt OP data ....................................................................................................... -typedef FAST FAST_LinStateSave SeaSt_ContinuousStateType x_SeaSt {:} - - "Continuous states" -typedef ^ ^ SeaSt_DiscreteStateType xd_SeaSt {:} - - "Discrete states" -typedef ^ ^ SeaSt_ConstraintStateType z_SeaSt {:} - - "Constraint states" -typedef ^ ^ SeaSt_OtherStateType OtherSt_SeaSt {:} - - "Other states" -typedef ^ ^ SeaSt_InputType u_SeaSt {:} - - "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" @@ -341,8 +257,6 @@ typedef ^ FAST_LinType R8Ki B {:}{:} - - "B matrix" typedef ^ FAST_LinType R8Ki C {:}{:} - - "C matrix" typedef ^ FAST_LinType R8Ki D {:}{:} - - "D matrix" typedef ^ FAST_LinType R8Ki StateRotation {:}{:} - - "Matrix that rotates the continuous states" -typedef ^ FAST_LinType R8Ki StateRel_x {:}{:} - - "Matrix that defines the continuous states relative to root motion" -typedef ^ FAST_LinType R8Ki StateRel_xdot {:}{:} - - "Matrix that defines the continuous states relative to root motion" typedef ^ FAST_LinType Logical IsLoad_u {:} - - "Whether the input is a load (used for scaling for potentially ill-conditioned G matrix)" typedef ^ FAST_LinType Logical RotFrame_u {:} - - "Whether corresponding input is in rotating frame" typedef ^ FAST_LinType Logical RotFrame_y {:} - - "Whether corresponding output is in rotating frame" @@ -400,10 +314,9 @@ typedef ^ FAST_OutputFileType IntKi VTK_count - - - "Number of VTK files written 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 FAST_LinStateSave op - - - "operating points of states and inputs for VTK output of mode shapes" typedef ^ FAST_OutputFileType ReKi DriverWriteOutput {6} - - "pitch and tsr for current aero map case, plus error, number of iterations, wind speed, rotor speed" #typedef ^ FAST_OutputFileType CHARACTER(ChanLen) DriverWriteOutputHdr {:} - - "headers of data output from the driver" -#typedef ^ FAST_OutputFileType CHARACTER(ChanLen) DriverWriteOutputUnit {:} - - "units of data output from the driver" +#typedef ^ FAST_OutputFileType CHARACTER(ChanLen) DriverWriteOutputUnt {:} - - "units of data output from the driver" # ..... IceDyn data ....................................................................................................... @@ -414,13 +327,10 @@ typedef ^ ^ IceD_DiscreteStateType xd {:}{:} - - "Discrete states" typedef ^ ^ IceD_ConstraintStateType z {:}{:} - - "Constraint states" typedef ^ ^ IceD_OtherStateType OtherSt {:}{:} - - "Other states" typedef ^ ^ IceD_ParameterType p {:} - - "Parameters" -typedef ^ ^ IceD_InputType u {:} - - "System inputs" typedef ^ ^ IceD_OutputType y {:} - - "System outputs" typedef ^ ^ IceD_MiscVarType m {:} - - "Misc/optimization variables" typedef ^ ^ IceD_InputType Input {:}{:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ IceD_InputType Input_Saved {:}{:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:}{:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:}{:} - - "Backup Array of times associated with Input Array" # ..... BeamDyn data ....................................................................................................... # [ the last dimension of each allocatable array is for the instance of BeamDyn being used ] @@ -430,81 +340,56 @@ typedef ^ ^ BD_DiscreteStateType xd {:}{:} - - "Discrete states" typedef ^ ^ BD_ConstraintStateType z {:}{:} - - "Constraint states" typedef ^ ^ BD_OtherStateType OtherSt {:}{:} - - "Other states" 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 ^ ^ BD_InputType Input_Saved {:}{:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:}{:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:}{:} - - "Backup Array of times associated with Input Array" # ..... ElastoDyn data ....................................................................................................... -typedef FAST ElastoDyn_Data ED_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ ED_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ ED_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ ED_OtherStateType OtherSt {NumStateTimes} - - "Other states" -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 CalcSteady Azimuths" -typedef ^ ^ ED_OutputType Output_bak {:} - - "Backup Array of outputs associated with InputTimes" -typedef ^ ^ ED_OutputType y_interp - - - "interpolated system outputs for CalcSteady" -typedef ^ ^ ED_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ ED_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" -typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" +typedef FAST ElastoDyn_Data ED_ContinuousStateType x {:}{:} - - "Continuous states" +typedef ^ ^ ED_DiscreteStateType xd {:}{:} - - "Discrete states" +typedef ^ ^ ED_ConstraintStateType z {:}{:} - - "Constraint states" +typedef ^ ^ ED_OtherStateType OtherSt {:}{:} - - "Other states" +typedef ^ ^ ED_ParameterType p {:} - - "Parameters" +typedef ^ ^ ED_OutputType y {:} - - "System outputs" +typedef ^ ^ ED_MiscVarType m {:} - - "Misc (optimization) variables not associated with time" +typedef ^ ^ ED_InputType Input {:}{:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ DbKi InputTimes {:}{:} - - "Array of times associated with Input Array" # ..... Simplified-ElastoDyn data ............................................................................................ -typedef FAST SED_Data SED_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ SED_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ SED_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ SED_OtherStateType OtherSt {2} - - "Other states" +typedef FAST SED_Data SED_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ SED_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ SED_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ SED_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ SED_ParameterType p - - - "Parameters" -typedef ^ ^ SED_InputType u - - - "System inputs" typedef ^ ^ SED_OutputType y - - - "System outputs" typedef ^ ^ SED_MiscVarType m - - - "Misc (optimization) variables not associated with time" -typedef ^ ^ SED_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" -typedef ^ ^ SED_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ SED_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... ServoDyn data ....................................................................................................... -typedef FAST ServoDyn_Data SrvD_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ SrvD_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ SrvD_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ SrvD_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef FAST ServoDyn_Data SrvD_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ SrvD_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ SrvD_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ SrvD_OtherStateType OtherSt {:} - - "Other states" 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_MiscVarType m_bak - - - "Backup 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 ^ ^ SrvD_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... AeroDyn data ....................................................................................................... -typedef FAST AeroDyn_Data AD_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ AD_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ AD_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ AD_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef FAST AeroDyn_Data AD_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ AD_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ AD_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ AD_OtherStateType OtherSt {:} - - "Other states" 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 ^ ^ AD_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... ExtLoads data ....................................................................................................... typedef FAST ExtLoads_Data ExtLd_ContinuousStateType x {NumStateTimes} - - "Continuous states" @@ -518,34 +403,26 @@ typedef ^ ^ ExtLd_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... AeroDisk data ....................................................................................................... -typedef FAST AeroDisk_Data ADsk_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ ADsk_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ ADsk_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ ADsk_OtherStateType OtherSt {2} - - "Other states" +typedef FAST AeroDisk_Data ADsk_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ ADsk_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ ADsk_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ ADsk_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ ADsk_ParameterType p - - - "Parameters" -typedef ^ ^ ADsk_InputType u - - - "System inputs" typedef ^ ^ ADsk_OutputType y - - - "System outputs" typedef ^ ^ ADsk_MiscVarType m - - - "Misc/optimization variables" -typedef ^ ^ ADsk_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" -typedef ^ ^ ADsk_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ ADsk_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... InflowWind data ....................................................................................................... -typedef FAST InflowWind_Data InflowWind_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ InflowWind_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ InflowWind_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ InflowWind_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef FAST InflowWind_Data InflowWind_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ InflowWind_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ InflowWind_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ InflowWind_OtherStateType OtherSt {:} - - "Other states" 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 ^ ^ InflowWind_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... ExternalInflow integration data ....................................................................................................... typedef FAST ExternalInflow_Data ExtInfw_InputType u - - - "System inputs" @@ -559,140 +436,106 @@ typedef ^ ^ SC_DX_OutputType y - - - "System outputs" typedef ^ ^ SC_DX_ParameterType p - - - "System parameters" # ..... SubDyn data ....................................................................................................... -typedef FAST SubDyn_Data SD_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ SD_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ SD_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ SD_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef FAST SubDyn_Data SD_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ SD_ContinuousStateType dxdt - - - "Continuous state derivatives" +typedef ^ ^ SD_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ SD_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ SD_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ SD_ParameterType p - - - "Parameters" -typedef ^ ^ SD_InputType u - - - "System inputs" typedef ^ ^ SD_OutputType y - - - "System outputs" typedef ^ ^ SD_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ SD_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ SD_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" -typedef ^ ^ SD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" -typedef ^ ^ SD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... ExtPtfm data ....................................................................................................... -typedef FAST ExtPtfm_Data ExtPtfm_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ ExtPtfm_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ ExtPtfm_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ ExtPtfm_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef FAST ExtPtfm_Data ExtPtfm_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ ExtPtfm_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ ExtPtfm_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ ExtPtfm_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ ExtPtfm_ParameterType p - - - "Parameters" -typedef ^ ^ ExtPtfm_InputType u - - - "System inputs" typedef ^ ^ ExtPtfm_OutputType y - - - "System outputs" typedef ^ ^ ExtPtfm_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ ExtPtfm_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ ExtPtfm_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... SeaState data ....................................................................................................... -typedef FAST SeaState_Data SeaSt_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ SeaSt_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ SeaSt_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ SeaSt_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef FAST SeaState_Data SeaSt_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ SeaSt_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ SeaSt_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ SeaSt_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ SeaSt_ParameterType p - - - "Parameters" -typedef ^ ^ SeaSt_InputType u - - - "System inputs" typedef ^ ^ SeaSt_OutputType y - - - "System outputs" typedef ^ ^ SeaSt_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ SeaSt_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ SeaSt_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" -typedef ^ ^ SeaSt_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" -typedef ^ ^ SeaSt_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... HydroDyn data ....................................................................................................... -typedef FAST HydroDyn_Data HydroDyn_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ HydroDyn_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ HydroDyn_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ HydroDyn_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef FAST HydroDyn_Data HydroDyn_ContinuousStateType x {:} - - "Continuous states" +typedef FAST HydroDyn_Data HydroDyn_ContinuousStateType dxdt - - - "Continuous state derivatives" +typedef ^ ^ HydroDyn_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ HydroDyn_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ HydroDyn_OtherStateType OtherSt {:} - - "Other states" 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 ^ ^ HydroDyn_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... IceFloe data ....................................................................................................... -typedef FAST IceFloe_Data IceFloe_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ IceFloe_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ IceFloe_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ IceFloe_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef FAST IceFloe_Data IceFloe_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ IceFloe_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ IceFloe_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ IceFloe_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ IceFloe_ParameterType p - - - "Parameters" -typedef ^ ^ IceFloe_InputType u - - - "System inputs" typedef ^ ^ IceFloe_OutputType y - - - "System outputs" typedef ^ ^ IceFloe_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ IceFloe_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ IceFloe_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... MAP data ....................................................................................................... -typedef FAST MAP_Data MAP_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ MAP_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ MAP_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef FAST MAP_Data MAP_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ MAP_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ MAP_ConstraintStateType z {:} - - "Constraint states" typedef ^ ^ MAP_OtherStateType OtherSt - - - "Other/optimization states" typedef ^ ^ MAP_ParameterType p - - - "Parameters" -typedef ^ ^ MAP_InputType u - - - "System inputs" typedef ^ ^ MAP_OutputType y - - - "System outputs" +typedef ^ ^ MAP_MiscVarType m - - - "Misc/optimization variables" 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 ^ ^ MAP_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... FEAMooring data ....................................................................................................... -typedef FAST FEAMooring_Data FEAM_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ FEAM_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ FEAM_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ FEAM_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef FAST FEAMooring_Data FEAM_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ FEAM_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ FEAM_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ FEAM_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ FEAM_ParameterType p - - - "Parameters" -typedef ^ ^ FEAM_InputType u - - - "System inputs" typedef ^ ^ FEAM_OutputType y - - - "System outputs" typedef ^ ^ FEAM_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ FEAM_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ FEAM_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... MoorDyn data ....................................................................................................... -typedef FAST MoorDyn_Data MD_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ MD_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ MD_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ MD_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef FAST MoorDyn_Data MD_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ MD_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ MD_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ MD_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ MD_ParameterType p - - - "Parameters" -typedef ^ ^ MD_InputType u - - - "System inputs" typedef ^ ^ MD_OutputType y - - - "System outputs" typedef ^ ^ MD_MiscVarType m - - - "Misc/optimization variables" -typedef ^ ^ MD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" -typedef ^ ^ MD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ MD_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ MD_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... OrcaFlex data ....................................................................................................... -typedef FAST OrcaFlex_Data Orca_ContinuousStateType x {NumStateTimes} - - "Continuous states" -typedef ^ ^ Orca_DiscreteStateType xd {NumStateTimes} - - "Discrete states" -typedef ^ ^ Orca_ConstraintStateType z {NumStateTimes} - - "Constraint states" -typedef ^ ^ Orca_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef FAST OrcaFlex_Data Orca_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ Orca_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ Orca_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ Orca_OtherStateType OtherSt {:} - - "Other states" typedef ^ ^ Orca_ParameterType p - - - "Parameters" -typedef ^ ^ Orca_InputType u - - - "System inputs" typedef ^ ^ Orca_OutputType y - - - "System outputs" typedef ^ ^ Orca_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ Orca_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ Orca_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... FAST_ModuleMapType data ....................................................................................................... # ! Data structures for mapping and coupling the various modules together @@ -828,7 +671,7 @@ typedef ^ FAST_MiscVarType FAST_MiscLinType Lin - - - "misc data for linearizati # ..... 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 ED_InitOutputType OutData_ED : - - "ED Initialization output data" typedef ^ FAST_InitData SED_InitInputType InData_SED - - - "SED Initialization input data" typedef ^ FAST_InitData SED_InitOutputType OutData_SED - - - "SED Initialization output data" typedef ^ FAST_InitData BD_InitInputType InData_BD - - - "BD Initialization input data" @@ -896,6 +739,9 @@ typedef ^ FAST_TurbineType IntKi TurbID - 1 - "Turbine ID Number" - typedef ^ FAST_TurbineType FAST_ParameterType p_FAST - - - "Parameters for the glue code" - typedef ^ FAST_TurbineType FAST_OutputFileType y_FAST - - - "Output variables for the glue code" - typedef ^ FAST_TurbineType FAST_MiscVarType m_FAST - - - "Miscellaneous variables" - +typedef ^ FAST_TurbineType Glue_ParameterType p_Glue - - - "Parameters for the glue code" - +typedef ^ FAST_TurbineType Glue_OutputFileType y_Glue - - - "Output variables for the glue code" - +typedef ^ FAST_TurbineType Glue_MiscVarType m_Glue - - - "Miscellaneous variables" - typedef ^ FAST_TurbineType FAST_ModuleMapType MeshMapData - - - "Data for mapping between modules" - typedef ^ FAST_TurbineType ElastoDyn_Data ED - - - "Data for the ElastoDyn module" - typedef ^ FAST_TurbineType SED_Data SED - - - "Data for the Simplified-ElastoDyn module" - diff --git a/modules/openfast-library/src/FAST_SS_Solver.f90 b/modules/openfast-library/src/FAST_SS_Solver.f90 deleted file mode 100644 index f4ea398e61..0000000000 --- a/modules/openfast-library/src/FAST_SS_Solver.f90 +++ /dev/null @@ -1,2169 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2020 Envision Energy USA, National Renewable Energy Laboratory -! -! This file is part of FAST. -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! limitations under the License. -!********************************************************************************************************************************** -!> This module contains the routines used by FAST to solve input-output equations and to advance states. -MODULE FAST_SS_Solver - - USE FAST_SOLVER - USE FAST_Linear - USE FAST_Subs - USE BeamDyn_Subs, ONLY: BD_CrvMatrixR, BD_CrvExtractCrv - - IMPLICIT NONE - - REAL(DbKi), PARAMETER :: SS_t_global = 0.0_DbKi - REAL(DbKi), PARAMETER :: UJacSclFact_x = 1.0d3 - - LOGICAL, PARAMETER :: output_debugging = .false. - -CONTAINS -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE SteadyStateCCSD( caseData, p_FAST, y_FAST, m_FAST, ED, BD, InputIndex, ErrStat, ErrMsg ) - - TYPE(FAST_SS_CaseType) , INTENT(IN ) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case - 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 - INTEGER(IntKi), INTENT(IN ) :: InputIndex !< Index into input array - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message - - INTEGER(IntKi) :: i - INTEGER(IntKi) :: k - INTEGER(IntKi) :: BldMeshNode - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - CHARACTER(*), PARAMETER :: RoutineName = 'SteadyStateCCSD' - REAL(R8Ki) :: Omega_Hub(3) - REAL(R8Ki) :: position(3) - REAL(R8Ki) :: omega_cross_position(3) - - ErrStat = ErrID_None - ErrMsg = "" - - IF (p_FAST%CompElast == Module_ED) THEN - CALL ED_CalcContStateDeriv( SS_t_global, ED%Input(InputIndex), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), & - ED%OtherSt(STATE_CURR), ED%m, ED%x(STATE_PRED), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ELSEIF (p_FAST%CompElast == Module_BD) THEN - Omega_Hub(1) = caseData%RotSpeed - Omega_Hub(2:3) = 0.0_R8Ki - - DO K = 1,p_FAST%nBeams - CALL BD_CalcContStateDeriv( SS_t_global, BD%Input(InputIndex,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%m(k), BD%x(k,STATE_PRED), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! subtract xdot(y) here: - ! note that this only works when the BldMotion mesh is on the FE nodes - do i=2,BD%p(k)%node_total ! the first node isn't technically a state - BldMeshNode = BD%p(k)%NdIndx(i) - position = BD%y(k)%BldMotion%Position(:,BldMeshNode) + BD%y(k)%BldMotion%TranslationDisp(:,BldMeshNode) - omega_cross_position = cross_product( Omega_Hub, position ) - - BD%x(k, STATE_PRED)%q( 1:3,i) = BD%x(k, STATE_PRED)%q( 1:3,i) - omega_cross_position - BD%x(k, STATE_PRED)%q( 4:6,i) = BD%x(k, STATE_PRED)%q( 4:6,i) - Omega_Hub - BD%x(k, STATE_PRED)%dqdt( 1:3,i) = BD%x(k, STATE_PRED)%dqdt( 1:3,i) - cross_product( Omega_Hub, omega_cross_position ) - end do - - END DO - END IF - -END SUBROUTINE SteadyStateCCSD -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE SteadyStateCalculatedInputs( p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, InputIndex, 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 - 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(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - INTEGER(IntKi), INTENT(IN ) :: InputIndex !< Index into input array - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message - - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - CHARACTER(*), PARAMETER :: RoutineName = 'SteadyStateCalculatedInputs' - - ErrStat = ErrID_None - ErrMsg = "" - - ! transfer the motions first: - CALL SS_AD_InputSolve( p_FAST, AD%Input(InputIndex), ED%y, BD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! transfer the loads next: - IF (p_FAST%CompElast == Module_ED) THEN - CALL SS_ED_InputSolve( p_FAST, ED%Input(InputIndex), ED%y, AD%y, AD%Input(InputIndex), MeshMapData, ErrStat2, ErrMsg2 ) - - ELSEIF (p_FAST%CompElast == Module_BD) THEN - CALL SS_BD_InputSolve( p_FAST, BD, AD%y, AD%Input(InputIndex), MeshMapData, InputIndex, ErrStat2, ErrMsg2 ) - END IF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - -END SUBROUTINE SteadyStateCalculatedInputs -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets the blade load inputs required for BD. -SUBROUTINE SS_BD_InputSolve( p_FAST, BD, y_AD, u_AD, MeshMapData, InputIndex, 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(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - INTEGER(IntKi), INTENT(IN ) :: InputIndex !< Index into input array - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message - - ! local variables - 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 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_BD_InputSolve' - - ! Initialize error status - - ErrStat = ErrID_None - ErrMsg = "" - - - ! BD inputs on blade from AeroDyn - - if (p_FAST%BD_OutputSibling) then - - DO K = 1, p_FAST%NumBl_Lin ! we don't need all blades here: p_FAST%nBeams ! Loop through all blades - - CALL Transfer_Line2_to_Line2( y_AD%rotors(1)%BladeLoad(k), BD%Input(InputIndex,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), BD%y(k)%BldMotion ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - END DO - - else - DO K = 1, p_FAST%NumBl_Lin ! we don't need all blades here: p_FAST%nBeams ! Loop through all blades - - ! need to transfer the BD output blade motions to nodes on a sibling of the BD blade motion mesh: - CALL Transfer_Line2_to_Line2( BD%y(k)%BldMotion, MeshMapData%y_BD_BldMotion_4Loads(k), MeshMapData%BD_L_2_BD_L(k), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL Transfer_Line2_to_Line2( y_AD%rotors(1)%BladeLoad(k), BD%Input(InputIndex,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), MeshMapData%y_BD_BldMotion_4Loads(k) ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - END DO - end if - - - -END SUBROUTINE SS_BD_InputSolve -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets the blade-load ElastoDyn inputs from blade 1 to the other blades. -SUBROUTINE SS_BD_InputSolve_OtherBlades( p_FAST, BD, MeshMapData, InputIndex ) - - ! Passed variables - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD Inputs at t - - TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules - INTEGER(IntKi), INTENT(IN ) :: InputIndex !< Index into input array - - ! Local variables: - - INTEGER(IntKi) :: K ! Loops through blades - INTEGER(IntKi) :: J ! Loops through nodes - - - DO k = p_FAST%NumBl_Lin+1,p_FAST%nBeams - DO j=1,BD%Input(InputIndex,k)%DistrLoad%NNodes - BD%Input(InputIndex,k)%DistrLoad%Force( :,j) = MATMUL(BD%Input(InputIndex,1)%DistrLoad%Force( :,j), MeshMapData%HubOrient(:,:,k) ) - BD%Input(InputIndex,k)%DistrLoad%Moment(:,j) = MATMUL(BD%Input(InputIndex,1)%DistrLoad%Moment(:,j), MeshMapData%HubOrient(:,:,k) ) - END DO - END DO - -END SUBROUTINE SS_BD_InputSolve_OtherBlades - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets the blade load inputs required for ED. -SUBROUTINE SS_ED_InputSolve( p_FAST, u_ED, y_ED, y_AD, u_AD, MeshMapData, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - 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(IN ) :: u_AD !< AD inputs (for AD-ED load transfer) - - 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 - - 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 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_ED_InputSolve' - - - ! Initialize error status - - ErrStat = ErrID_None - ErrMsg = "" - - ! ED inputs on blade from AeroDyn - - DO K = 1, p_FAST%NumBl_Lin !we don't need all blades here: SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) - CALL Transfer_Line2_to_Point( y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), y_ED%BladeLn2Mesh(k) ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END DO - -END SUBROUTINE SS_ED_InputSolve -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets the blade-load ElastoDyn inputs from blade 1 to the other blades. -SUBROUTINE SS_ED_InputSolve_OtherBlades( p_FAST, u_ED, MeshMapData ) - - ! Passed variables - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data - TYPE(ED_InputType), INTENT(INOUT) :: u_ED !< ED Inputs at t - TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules - - ! Local variables: - - INTEGER(IntKi) :: K ! Loops through blades - INTEGER(IntKi) :: J ! Loops through nodes - - - DO k = p_FAST%NumBl_Lin+1,size(u_ED%BladePtLoads,1) - DO j=1,u_ED%BladePtLoads(k)%NNodes - u_ED%BladePtLoads(k)%Force( :,j) = MATMUL(u_ED%BladePtLoads(1)%Force( :,j), MeshMapData%HubOrient(:,:,k) ) - u_ED%BladePtLoads(k)%Moment(:,j) = MATMUL(u_ED%BladePtLoads(1)%Moment(:,j), MeshMapData%HubOrient(:,:,k) ) - END DO - END DO - -END SUBROUTINE SS_ED_InputSolve_OtherBlades - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets the blade-motion AeroDyn inputs. -SUBROUTINE SS_AD_InputSolve( p_FAST, u_AD, y_ED, BD, MeshMapData, ErrStat, ErrMsg ) - - ! Passed variables - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data - TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn14 - TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the structural dynamics module - TYPE(BeamDyn_Data), INTENT(IN) :: BD !< The data from BeamDyn (want the outputs only, but it's in an array) - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - - INTEGER(IntKi) :: ErrStat !< Error status of the operation - CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! Local variables: - - INTEGER(IntKi) :: K ! Loops through blades - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_AD_InputSolve' - - - ErrStat = ErrID_None - ErrMsg = "" - - !------------------------------------------------------------------------------------------------- - ! Set the inputs from structure: - !------------------------------------------------------------------------------------------------- - IF (p_FAST%CompElast == Module_ED ) THEN - - DO k=1,p_FAST%NumBl_Lin !we don't need all blades here: size(y_ED%BladeLn2Mesh) - CALL Transfer_Line2_to_Line2( y_ED%BladeLn2Mesh(k), u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeMotion('//trim(num2lstr(k))//')' ) - END DO - - ELSEIF (p_FAST%CompElast == Module_BD ) THEN - - ! get them from BeamDyn - DO k=1,p_FAST%NumBl_Lin !we don't need all blades here: size(u_AD%BladeMotion) - CALL Transfer_Line2_to_Line2( BD%y(k)%BldMotion, u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeMotion('//trim(num2lstr(k))//')' ) - END DO - - END IF - - ! make sure these are the prescribed values: - DO k = 1,p_FAST%NumBl_Lin !we don't need all blades here: size(u_AD%BladeMotion,1) - u_AD%rotors(1)%BladeMotion(k)%RotationVel = 0.0_ReKi - u_AD%rotors(1)%BladeMotion(k)%TranslationAcc = 0.0_ReKi - END DO - - -END SUBROUTINE SS_AD_InputSolve -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets the blade-motion AeroDyn inputs. -SUBROUTINE SS_AD_InputSolve_OtherBlades( p_FAST, u_AD, MeshMapData ) - - ! Passed variables - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data - TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn14 - TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules - - ! Local variables: - - INTEGER(IntKi) :: K ! Loops through blades - INTEGER(IntKi) :: J ! Loops through nodes - - - DO k = p_FAST%NumBl_Lin+1,size(u_AD%rotors(1)%BladeMotion,1) - DO j=1,u_AD%rotors(1)%BladeMotion(k)%NNodes - u_AD%rotors(1)%BladeMotion(k)%TranslationDisp(:,j) = MATMUL( u_AD%rotors(1)%BladeMotion(1)%TranslationDisp(:,j), MeshMapData%HubOrient(:,:,k) ) - u_AD%rotors(1)%BladeMotion(k)%Orientation( :,:,j) = MATMUL( u_AD%rotors(1)%BladeMotion(1)%Orientation( :,:,j), MeshMapData%HubOrient(:,:,k) ) - u_AD%rotors(1)%BladeMotion(k)%TranslationVel( :,j) = MATMUL( u_AD%rotors(1)%BladeMotion(1)%TranslationVel( :,j), MeshMapData%HubOrient(:,:,k) ) - END DO - END DO - -END SUBROUTINE SS_AD_InputSolve_OtherBlades - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine performs the Input-Output solve for the steady-state solver. -!! Note that this has been customized for the physics in the problems and is not a general solution. -SUBROUTINE SolveSteadyState( caseData, Jmat, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData , ErrStat, ErrMsg ) -!.................................................................................................................................. - - ! Passed variables - TYPE(FAST_SS_CaseType) , INTENT(IN ) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case - REAL(R8Ki), INTENT(INOUT) :: Jmat(:,:) !< temporary storage space for jacobian matrix - - TYPE(FAST_ParameterType) , INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType) , INTENT(INOUT) :: y_FAST !< Glue-code output file values - 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(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - - 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 - - ! Local variables: - CHARACTER(*), PARAMETER :: RoutineName = 'SolveSteadyState' - -!bjj: store these so that we don't reallocate every time? - REAL(R8Ki) :: u( p_FAST%SizeJac_Opt1(1)) ! size of loads/accelerations passed between the 6 modules - REAL(R8Ki) :: u_delta( p_FAST%SizeJac_Opt1(1)) ! size of loads/accelerations passed between the 6 modules - REAL(R8Ki) :: Fn_U_Resid( p_FAST%SizeJac_Opt1(1)) ! Residual of U - REAL(R8Ki) :: err - REAL(R8Ki) :: err_prev - REAL(R8Ki), PARAMETER :: reduction_factor = 0.1_R8Ki - - INTEGER(IntKi) :: nb ! loop counter (blade number) - INTEGER(IntKi) :: MaxIter ! maximum number of iterations - INTEGER(IntKi) :: K ! Input-output-solve iteration counter - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - 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 - - ErrStat = ErrID_None - ErrMsg = "" - !---------------------------------------------------------------------------------------------------- - ! Some record keeping stuff: - !---------------------------------------------------------------------------------------------------- - - CALL SteadyStateUpdateStates( caseData, p_FAST, ED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL SteadyStatePrescribedInputs( caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD ) - CALL CopyStatesInputs( p_FAST, ED, BD, AD, ErrStat2, ErrMsg2, MESH_UPDATECOPY ) ! COPY the inputs to the temp copy (so we get updated input values) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - K = 0 - err = 1.0E3 - err_prev = err - - y_FAST%DriverWriteOutput(SS_Indx_Err) = -1 - y_FAST%DriverWriteOutput(SS_Indx_Iter) = 0 - y_FAST%DriverWriteOutput(SS_Indx_TSR) = caseData%tsr - y_FAST%DriverWriteOutput(SS_Indx_WS) = caseData%windSpeed - y_FAST%DriverWriteOutput(SS_Indx_Pitch) = caseData%Pitch*R2D - y_FAST%DriverWriteOutput(SS_Indx_RotSpeed) = caseData%RotSpeed*RPS2RPM - - MaxIter = p_FAST%KMax + 1 ! adding 1 here so that we get the error calculated correctly when we hit the max iteration - DO - - !------------------------------------------------------------------------------------------------- - ! Calculate outputs, based on inputs at this time - !------------------------------------------------------------------------------------------------- - GetWriteOutput = K > 0 ! we can skip this on the first call (because we always calculate outputs twice) - - IF ( p_FAST%CompElast == Module_ED ) THEN - CALL ED_CalcOutput( SS_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, ED%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSEIF ( p_FAST%CompElast == Module_BD) THEN - do nb=1,p_FAST%nBeams - CALL BD_CalcOutput( SS_t_global, BD%Input(1,nb), BD%p(nb), BD%x(nb, STATE_CURR), BD%xd(nb, STATE_CURR), BD%z(nb, STATE_CURR), BD%OtherSt(nb, STATE_CURR), & - BD%y(nb), BD%m(nb), ErrStat2, ErrMsg2, GetWriteOutput ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end do - END IF - - IF (K==0) THEN - - ! set the AD input guess based on the structural output (this will ensure that the pitch is accounted for in the fixed aero-map solve:): - CALL SS_AD_InputSolve( p_FAST, AD%Input(1), ED%y, BD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL SS_AD_InputSolve_OtherBlades( p_FAST, AD%Input(1), MeshMapData ) ! transfer results from blade 1 to other blades - - !---------------------------------------------------------------------------------------------------- - ! set up x-u vector, using local initial guesses: - !---------------------------------------------------------------------------------------------------- - CALL Create_SS_Vector( p_FAST, y_FAST, u, AD, ED, BD, 1, STATE_CURR ) - - END IF - - CALL AD_CalcOutput(SS_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, GetWriteOutput ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - call resetInputsAndStates() - RETURN - END IF - - IF (K >= MaxIter) EXIT - - - !------------------------------------------------------------------------------------------------- - ! Calculate residual and the Jacobian: - ! (note that we don't want to change module%Input(1), here) - ! Also, the residual uses values from y_FAST, so do this before calculating the jacobian - !------------------------------------------------------------------------------------------------- - CALL SteadyStateSolve_Residual(caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, u, Fn_U_Resid, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - call resetInputsAndStates() - RETURN - END IF - - IF ( mod( K, p_FAST%N_UJac ) == 0 ) THEN - CALL FormSteadyStateJacobian( caseData, Jmat, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - call Precondition_Jmat(p_FAST, y_FAST, Jmat) - - ! Get the LU decomposition of this matrix using a LAPACK routine: - ! The result is of the form Jmat = P * L * U - - CALL LAPACK_getrf( M=size(Jmat,1), N=size(Jmat,2), & - A=Jmat, IPIV=MeshMapData%Jacobian_pivot, & - ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - call resetInputsAndStates() - RETURN - END IF - - END IF - - !------------------------------------------------------------------------------------------------- - ! Solve for delta u: Jac*u_delta = - Fn_U_Resid - ! using the LAPACK routine - !------------------------------------------------------------------------------------------------- - - u_delta = -Fn_U_Resid - CALL LAPACK_getrs( TRANS="N", N=SIZE(Jmat,1), A=Jmat, & - IPIV=MeshMapData%Jacobian_pivot, B=u_delta, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - !------------------------------------------------------------------------------------------------- - ! check for error, update inputs if necessary, and iterate again - !------------------------------------------------------------------------------------------------- - err_prev = err - err = DOT_PRODUCT(u_delta, u_delta) - y_FAST%DriverWriteOutput(SS_Indx_Err) = sqrt(err) / p_FAST%SizeJac_Opt1(1) - - IF ( err <= p_FAST%TolerSquared) THEN - IF (K==0) THEN ! the error will be incorrect in this instance, but the outputs will be better - MaxIter = K - ELSE - EXIT - END IF - END IF - - IF (K >= p_FAST%KMax ) EXIT - IF (K > 5 .and. err > 1.0E35) EXIT ! this is obviously not converging. Let's try something else. - - !------------------------------------------------------------------------------------------------- - ! modify inputs and states for next iteration - !------------------------------------------------------------------------------------------------- - if (err > err_prev ) then - u_delta = u_delta * reduction_factor ! don't take a full step if we're getting farther from the solution! - err_prev = err_prev * reduction_factor - end if - - CALL Add_SteadyState_delta( p_FAST, y_FAST, u_delta, AD, ED, BD, MeshMapData ) - - !u = u + u_delta - CALL Create_SS_Vector( p_FAST, y_FAST, u, AD, ED, BD, 1, STATE_CURR ) - - K = K + 1 - y_FAST%DriverWriteOutput(SS_Indx_Iter) = k - - END DO ! K - - IF ( p_FAST%CompElast == Module_BD ) THEN - ! this doesn't actually get the correct hub point load from BD, but we'll get some outputs: - CALL ED_CalcOutput( SS_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, ED%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - call resetInputsAndStates() - -contains - subroutine resetInputsAndStates() - - IF ( err > p_FAST%TolerSquared ) THEN - CALL SetErrStat(ErrID_Severe, 'Steady-state solver did not converge.', ErrStat, ErrMsg, RoutineName) - - IF ( err > 100.0 ) THEN - ! if we didn't get close on the solution, we should reset the states and inputs because they very well could - ! lead to numerical issues on the next iteration. Here, set the initial values to 0: - - ! because loads occasionally get very large when it fails, manually set these to zero (otherwise - ! roundoff can lead to non-zero values with the method below, which is most useful for states) - IF( p_FAST%CompElast == Module_BD ) THEN - DO K = 1,p_FAST%nBeams - BD%Input(1,k)%DistrLoad%Force = 0.0_ReKi - BD%Input(1,k)%DistrLoad%Moment = 0.0_ReKi - END DO - - END IF - - CALL Create_SS_Vector( p_FAST, y_FAST, u, AD, ED, BD, 1, STATE_CURR ) ! find the values we have been modifying (in u... continuous states and inputs) - CALL Add_SteadyState_delta( p_FAST, y_FAST, -u, AD, ED, BD, MeshMapData ) ! and reset them to 0 (by adding -u) - - END IF - END IF - end subroutine resetInputsAndStates - -END SUBROUTINE SolveSteadyState -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE SteadyStateSolve_Residual(caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, u_in, u_resid, ErrStat, ErrMsg) - ! Passed variables - TYPE(FAST_SS_CaseType) , INTENT(IN ) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case - TYPE(FAST_ParameterType) , INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType) , INTENT(INOUT) :: y_FAST !< Glue-code output file values - 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(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - - TYPE(FAST_ModuleMapType) , INTENT(INOUT) :: MeshMapData !< data for mapping meshes between modules - REAL( R8Ki ) , INTENT(IN ) :: u_in(:) !< The residual of the array of states and inputs we are trying to solve for - REAL( R8Ki ) , INTENT( OUT) :: u_resid(:) !< The residual of the array of states and inputs we are trying to solve for - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - INTEGER(IntKi) :: Indx_u_start - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SteadyStateSolve_Residual' - - integer, parameter :: InputIndex = 2 - - ErrStat = ErrID_None - ErrMsg = "" - - !note: prescribed inputs are already set in both InputIndex=1 and InputIndex=2 so we can ignore them here - - call SteadyStateCCSD( caseData, p_FAST, y_FAST, m_FAST, ED, BD, 1, ErrStat2, ErrMsg2 ) ! use current inputs and calculate CCSD in STATE_PRED - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! note that we don't need to calculate the inputs on more than p_FAST%NumBl_Lin blades because we are only using them to compute the Create_SS_Vector - call SteadyStateCalculatedInputs( p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, InputIndex, ErrStat2, ErrMsg2 ) ! calculate new inputs and store in InputIndex=2 - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - !.................. - ! Pack the output "residual vector" with these state derivatives and new inputs: - !.................. - CALL Create_SS_Vector( p_FAST, y_FAST, U_Resid, AD, ED, BD, InputIndex, STATE_PRED ) - - ! Make the inputs a residual (subtract from previous inputs) - Indx_u_start = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + 1 - U_Resid(Indx_u_start : ) = u_in(Indx_u_start : ) - U_Resid(Indx_u_start : ) - -END SUBROUTINE SteadyStateSolve_Residual -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine saves the current states so they can be used to compute the residual. -SUBROUTINE CopyStatesInputs( p_FAST, ED, BD, AD, ErrStat, ErrMsg, CtrlCode ) - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - - 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 = 'CopyStatesInputs' - - - ErrStat = ErrID_None - ErrMsg = "" - - - !---------------------------------------------------------------------------------------- - !! copy the operating point of the states and inputs - !---------------------------------------------------------------------------------------- - - ! ElastoDyn: copy states and inputs - IF ( CtrlCode == MESH_NEWCOPY ) THEN - CALL ED_CopyContState (ED%x( STATE_CURR), ED%x( STATE_PRED), CtrlCode, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_CURR), ED%xd(STATE_PRED), CtrlCode, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_CURR), ED%z( STATE_PRED), CtrlCode, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), ED%OtherSt( STATE_PRED), CtrlCode, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - CALL ED_CopyInput (ED%Input(1), ED%Input(2), 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 - - IF ( CtrlCode == MESH_NEWCOPY ) THEN - DO k=1,p_FAST%nBeams - CALL BD_CopyContState (BD%x( k,STATE_CURR),BD%x( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_CURR),BD%xd(k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_CURR),BD%z( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_CURR),BD%OtherSt( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - END IF - - DO k=1,p_FAST%nBeams - CALL BD_CopyInput (BD%Input(1,k), BD%Input(2,k), CtrlCode, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - END IF - - - - ! AeroDyn: copy states and inputs to OP array - IF ( CtrlCode == MESH_NEWCOPY ) THEN - CALL AD_CopyContState (AD%x( STATE_CURR), AD%x( STATE_PRED), CtrlCode, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState (AD%xd(STATE_CURR), AD%xd(STATE_PRED), CtrlCode, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState (AD%z( STATE_CURR), AD%z( STATE_PRED), CtrlCode, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState( AD%OtherSt(STATE_CURR), AD%OtherSt(STATE_PRED), CtrlCode, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - CALL AD_CopyInput (AD%Input(1), AD%Input(2), CtrlCode, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - -END SUBROUTINE CopyStatesInputs -!---------------------------------------------------------------------------------------------------------------------------------- -! This routine sets the rotor speed for the steady state cases. Rotor speed is a continuous state. -SUBROUTINE SteadyStateUpdateStates(CaseData, p_FAST, ED, ErrStat, ErrMsg ) -!.................................................................................................................................. - - ! Passed variables - TYPE(FAST_SS_CaseType) , INTENT(IN ) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - - 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 = 'SteadyStateUpdateStates' - - - ErrStat = ErrID_None - ErrMsg = "" - - - ED%x(STATE_CURR)%QDT(p_FAST%GearBox_Index) = caseData%RotSpeed - -END SUBROUTINE SteadyStateUpdateStates -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine returns the preconditioned matrix, \f$ \hat{J} \f$, such that \f$ \hat{J} = S^(-1) J S \f$ with \f$S^(-1)\f$ defined -!! such that loads are scaled by p_FAST\%UJacSclFact. -SUBROUTINE Precondition_Jmat(p_FAST, y_FAST, Jmat) - - - 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 - REAL(R8Ki), INTENT(INOUT) :: JMat(:,:) !< variable for steady-state solve (in is Jmat; out is Jmat_hat) - - - integer :: r, c, nx - - nx = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) - - !! Change J to J_hat: - do c=1,nx ! states are not loads: - - do r = 1,size(y_FAST%Lin%Glue%IsLoad_u) - if ( y_FAST%Lin%Glue%IsLoad_u(r) ) then - ! column is motion, but row is a load: - JMat(nx+r,c) = JMat(nx+r,c) / p_FAST%UJacSclFact - end if - end do - - end do - - - do c = 1,size(y_FAST%Lin%Glue%IsLoad_u) - - if ( y_FAST%Lin%Glue%IsLoad_u(c) ) then - - do r=1,nx ! states are not loads: - ! column is load, but row is a motion: - JMat(r,nx+c) = JMat(r,nx+c) * p_FAST%UJacSclFact - end do - - do r = 1,size(y_FAST%Lin%Glue%IsLoad_u) - if ( .not. y_FAST%Lin%Glue%IsLoad_u(r) ) then - ! column is load, but row is a motion: - JMat(nx+r,nx+c) = JMat(nx+r,nx+c) * p_FAST%UJacSclFact - end if - end do - - else - - do r = 1,size(y_FAST%Lin%Glue%IsLoad_u) - if ( y_FAST%Lin%Glue%IsLoad_u(r) ) then - ! column is motion, but row is a load: - JMat(nx+r,nx+c) = JMat(nx+r,nx+c) / p_FAST%UJacSclFact - end if - end do - - end if - - end do - - - -END SUBROUTINE Precondition_Jmat - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine basically packs the relevant parts of the modules' inputs and states for use in the steady-state solver. -SUBROUTINE Create_SS_Vector( p_FAST, y_FAST, u, AD, ED, BD, InputIndex, StateIndex ) -!.................................................................................................................................. - TYPE(FAST_ParameterType) , INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Output variables for the glue code - REAL( R8Ki ) , INTENT(INOUT) :: u(:) !< The array of states and inputs we are trying to solve for - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - INTEGER(IntKi), INTENT(IN ) :: InputIndex - INTEGER(IntKi), INTENT(IN ) :: StateIndex - - ! local variables: - INTEGER :: n - INTEGER :: fieldIndx - INTEGER :: node - INTEGER :: indx, indx_last - INTEGER :: i, j, k - INTEGER :: nx, nStates - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMSg2 - - - nx = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) ! make sure this is only STRUCTURAL states!!! - - ! structural code states: - IF ( p_FAST%CompElast == Module_ED ) THEN !bjj: QUESTION/FIXME: does this work when BD is used? Don't we have a combination of ED and BD states then??? Or are these only states on the blades? - nStates = nx - - if (StateIndex == STATE_PRED) then !this is actually the derivative of the current states instead of the value of the current states - do j = 1, nStates - indx = ED%p%DOFs%PS((j-1)*ED%p%NActvDOF_Stride + 1) - u(j) = ED%x( StateIndex )%QDT(indx) - end do - else - do j = 1, nStates - indx = ED%p%DOFs%PS((j-1)*ED%p%NActvDOF_Stride + 1) - u(j) = ED%x( StateIndex )%QT(indx) - end do - end if - - ELSEIF ( p_FAST%CompElast == Module_BD ) THEN - nStates = nx / 2 - - DO k=1,p_FAST%nBeams - indx = 1 - do i=2,BD%p(k)%node_total ! the first node isn't technically a state - indx_last = indx + BD%p(k)%dof_node - 1 - u( indx:indx_last ) = BD%x(k, StateIndex)%q( :,i) - u(nStates+indx:indx_last+nStates) = BD%x(k, StateIndex)%dqdt( :,i) - indx = indx_last+1 - end do - END DO - END IF !CompElast - - - - ! inputs: - ! we are at u_delta(nx+1 : end) - n = nx+1 - IF ( p_FAST%CompElast == Module_ED ) THEN - - do K = 1,p_FAST%NumBl_Lin !we don't need all blades here: SIZE(ED%Input(InputIndex)%BladePtLoads,1) ! Loop through all blades - - do node = 1, ED%Input(InputIndex)%BladePtLoads(k)%NNodes - do fieldIndx = 1,3 - u(n) = ED%Input(InputIndex)%BladePtLoads(k)%Force( fieldIndx,node) / p_FAST%UJacSclFact - n = n+1 - end do - end do - - do node = 1, ED%Input(InputIndex)%BladePtLoads(k)%NNodes - do fieldIndx = 1,3 - u(n) = ED%Input(InputIndex)%BladePtLoads(k)%Moment( fieldIndx,node) / p_FAST%UJacSclFact - n = n+1 - end do - end do - - end do - - ELSEIF ( p_FAST%CompElast == Module_BD ) THEN - - do K = 1,p_FAST%NumBl_Lin !we don't need all blades here: p_FAST%nBeams ! Loop through all blades - - do node = 1, BD%Input(InputIndex,k)%DistrLoad%NNodes - do fieldIndx = 1,3 - u(n) = BD%Input(InputIndex,k)%DistrLoad%Force( fieldIndx,node) / p_FAST%UJacSclFact - n = n+1 - end do - end do - - do node = 1, BD%Input(InputIndex,k)%DistrLoad%NNodes - do fieldIndx = 1,3 - u(n) = BD%Input(InputIndex,k)%DistrLoad%Moment( fieldIndx,node) / p_FAST%UJacSclFact - n = n+1 - end do - end do - - end do - END IF !CompElast - - - ! AeroDyn - DO k=1,p_FAST%NumBl_Lin !we don't need all blades here: SIZE(AD%Input(InputIndex)%BladeMotion) - do node = 1, AD%Input(InputIndex)%rotors(1)%BladeMotion(k)%NNodes - do fieldIndx = 1,3 - u(n) = AD%Input(InputIndex)%rotors(1)%BladeMotion(k)%TranslationDisp( fieldIndx,node) - n = n+1 - end do - end do - - do node = 1, AD%Input(InputIndex)%rotors(1)%BladeMotion(k)%NNodes - CALL DCM_LogMap( AD%Input(InputIndex)%rotors(1)%BladeMotion(k)%Orientation(:,:,node), u(n:n+2), ErrStat2, ErrMsg2 ) - n = n+3 - end do - - do node = 1, AD%Input(InputIndex)%rotors(1)%BladeMotion(k)%NNodes - do fieldIndx = 1,3 - u(n) = AD%Input(InputIndex)%rotors(1)%BladeMotion(k)%TranslationVel( fieldIndx,node) - n = n+1 - end do - end do - - END DO - - -END SUBROUTINE Create_SS_Vector - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine adds u_delta to the corresponding mesh field and scales it as appropriate -SUBROUTINE Add_SteadyState_delta( p_FAST, y_FAST, u_delta, AD, ED, BD, MeshMapData ) -!.................................................................................................................................. - TYPE(FAST_ParameterType) , INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Output variables for the glue code - REAL( R8Ki ) , INTENT(IN ) :: u_delta(:) !< The delta amount to add to the appropriate mesh fields - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - TYPE(FAST_ModuleMapType) , INTENT(IN ) :: MeshMapData !< data for mapping meshes between modules - - ! local variables - INTEGER :: n - INTEGER :: fieldIndx - INTEGER :: node - INTEGER :: indx, indx_last - INTEGER :: i, j, k - INTEGER :: nx, nStates - - REAL(R8Ki) :: orientation(3,3) - REAL(R8Ki) :: rotation(3,3) - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - - - nx = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) - - ! structural code states: - IF ( p_FAST%CompElast == Module_ED ) THEN - nStates = nx - - do j = 1, nStates - - do k=1,ED%p%NActvDOF_Stride ! transfer these states to the other blades (this means that the original states MUST be set the same for all blades!!!) - indx = ED%p%DOFs%PS((j-1)*ED%p%NActvDOF_Stride + k) - - ED%x( STATE_CURR)%QT(indx) = ED%x( STATE_CURR)%QT( indx) + u_delta(j) - ED%x( STATE_CURR)%QDT(indx) = 0.0_R8Ki !ED%x( STATE_CURR)%QDT(indx) + u_delta(j+nStates) - end do - - end do - - - ELSEIF ( p_FAST%CompElast == Module_BD ) THEN - nStates = nx / 2 - - ! see BD's Perturb_x function: - - DO k=1,p_FAST%nBeams - indx = 1 - do i=2,BD%p(k)%node_total - indx_last = indx + BD%p(k)%dof_node - 1 - BD%x(k, STATE_CURR)%dqdt( :,i) = BD%x(k, STATE_CURR)%dqdt(:,i) + u_delta(nStates+indx:indx_last+nStates) - BD%x(k, STATE_CURR)%q( 1:3,i) = BD%x(k, STATE_CURR)%q( 1:3,i) + u_delta( indx:indx+2 ) - - ! w-m parameters - call BD_CrvMatrixR( BD%x(k, STATE_CURR)%q( 4:6,i), rotation ) ! returns the rotation matrix (transpose of DCM) that was stored in the state as a w-m parameter - orientation = transpose(rotation) - - call PerturbOrientationMatrix( Orientation, Perturbations = u_delta( indx+3:indx_last) ) - - rotation = transpose(orientation) - call BD_CrvExtractCrv( rotation, BD%x(k, STATE_CURR)%q( 4:6,i), ErrStat2, ErrMsg2 ) ! return the w-m parameters of the new orientation - - indx = indx_last+1 - end do - END DO - END IF !CompElast - - - - ! inputs: - ! we are at u_delta(nx+1 : end) - n = nx+1 - IF ( p_FAST%CompElast == Module_ED ) THEN - - do K = 1,p_FAST%NumBl_Lin !we don't need all blades here: SIZE(ED%Input(1)%BladePtLoads,1) ! Loop through all blades - - do node = 1, ED%Input(1)%BladePtLoads(k)%NNodes - do fieldIndx = 1,3 - ED%Input(1)%BladePtLoads(k)%Force( fieldIndx,node) = ED%Input(1)%BladePtLoads(k)%Force( fieldIndx,node) + u_delta(n) * p_FAST%UJacSclFact - n = n+1 - end do - end do - - do node = 1, ED%Input(1)%BladePtLoads(k)%NNodes - do fieldIndx = 1,3 - ED%Input(1)%BladePtLoads(k)%Moment( fieldIndx,node) = ED%Input(1)%BladePtLoads(k)%Moment( fieldIndx,node) + u_delta(n) * p_FAST%UJacSclFact - n = n+1 - end do - end do - - end do - - call SS_ED_InputSolve_OtherBlades( p_FAST, ED%Input(1), MeshMapData ) - - ELSEIF ( p_FAST%CompElast == Module_BD ) THEN - - do K = 1,p_FAST%NumBl_Lin !we don't need all blades here: p_FAST%nBeams ! Loop through all blades - - do node = 1, BD%Input(1,k)%DistrLoad%NNodes - do fieldIndx = 1,3 - BD%Input(1,k)%DistrLoad%Force( fieldIndx,node) = BD%Input(1,k)%DistrLoad%Force( fieldIndx,node) + u_delta(n) * p_FAST%UJacSclFact - n = n+1 - end do - end do - - do node = 1, BD%Input(1,k)%DistrLoad%NNodes - do fieldIndx = 1,3 - BD%Input(1,k)%DistrLoad%Moment( fieldIndx,node) = BD%Input(1,k)%DistrLoad%Moment( fieldIndx,node) + u_delta(n) * p_FAST%UJacSclFact - n = n+1 - end do - end do - - end do - - call SS_BD_InputSolve_OtherBlades( p_FAST, BD, MeshMapData, 1 ) ! 1 is for the input index (i.e., Input(1,Blades2-end) - - END IF !CompElast - - - ! AeroDyn - DO k=1,p_FAST%NumBl_Lin !we don't need all blades here: SIZE(AD%Input(1)%BladeMotion) - do node = 1, AD%Input(1)%rotors(1)%BladeMotion(k)%NNodes - do fieldIndx = 1,3 - AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationDisp( fieldIndx,node) = AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationDisp( fieldIndx,node) + u_delta(n) - n = n+1 - end do - end do - - do node = 1, AD%Input(1)%rotors(1)%BladeMotion(k)%NNodes - CALL PerturbOrientationMatrix( AD%Input(1)%rotors(1)%BladeMotion(k)%Orientation(:,:,node), Perturbations = u_delta(n:n+2) ) - n = n+3 - end do - - do node = 1, AD%Input(1)%rotors(1)%BladeMotion(k)%NNodes - AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationVel( :,node) = AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationVel( :,node) + u_delta(n:n+2) - - n = n+3 - end do - - END DO - - - ! now update the inputs on other blades: - CALL SS_AD_InputSolve_OtherBlades( p_FAST, AD%Input(1), MeshMapData ) ! transfer results from blade 1 to other blades - - -END SUBROUTINE Add_SteadyState_delta - -!---------------------------------------------------------------------------------------------------------------------------------- - - - - - -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE SteadyStatePrescribedInputs( caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD ) - TYPE(FAST_SS_CaseType) , INTENT(IN ) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case - 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(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - - INTEGER(IntKi) :: k - REAL(R8Ki) :: theta(3) - - ! Set prescribed inputs for all of the modules in the steady-state solve - - - ED%Input(1)%TwrAddedMass = 0.0_ReKi - ED%Input(1)%PtfmAddedMass = 0.0_ReKi - - ED%Input(1)%TowerPtLoads%Force = 0.0 - ED%Input(1)%TowerPtLoads%Moment = 0.0 - ED%Input(1)%NacelleLoads%Force = 0.0 - ED%Input(1)%NacelleLoads%Moment = 0.0 - ED%Input(1)%HubPtLoad%Force = 0.0 ! these are from BD, but they don't affect the ED calculations for aeromaps, so set them to 0 - ED%Input(1)%HubPtLoad%Moment = 0.0 ! these are from BD, but they don't affect the ED calculations for aeromaps, so set them to 0 - - ED%Input(1)%BlPitchCom = caseData%Pitch - ED%Input(1)%YawMom = 0.0 - ED%Input(1)%HSSBrTrqC = 0.0 - ED%Input(1)%GenTrq = 0.0 - - ! BeamDyn - IF (p_FAST%CompElast == Module_BD) THEN - - !CALL ED_CalcOutput( 0.0_DbKi, 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, ErrStat2, ErrMsg2 ) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - DO k = 1,p_FAST%nBeams - BD%Input(1,k)%RootMotion%TranslationDisp = 0.0_ReKi - - theta = EulerExtract(BD%Input(1,k)%RootMotion%RefOrientation(:,:,1)) - theta(3) = -caseData%Pitch - BD%Input(1,k)%RootMotion%Orientation(:,:,1) = EulerConstruct(theta) - - BD%Input(1,k)%RootMotion%RotationVel(1,1) = caseData%RotSpeed !BD%Input(1,k)%RootMotion%RotationVel = ED%y_interp%BladeRootMotion(k)%RotationVel - BD%Input(1,k)%RootMotion%RotationVel(2:3,1) = 0.0_ReKi - - BD%Input(1,k)%RootMotion%TranslationVel(:,1) = cross_product( BD%Input(1,k)%RootMotion%RotationVel(:,1), BD%Input(1,k)%RootMotion%Position(:,1) - AD%Input(1)%rotors(1)%HubMotion%Position(:,1) ) ! ED%y_interp%BladeRootMotion(k)%TranslationVel - BD%Input(1,k)%RootMotion%TranslationAcc(:,1) = cross_product( BD%Input(1,k)%RootMotion%RotationVel(:,1), BD%Input(1,k)%RootMotion%TranslationVel(:,1) ) ! ED%y_interp%BladeRootMotion(k)%TranslationAcc - - BD%Input(1,k)%RootMotion%RotationAcc = 0.0_ReKi - END DO ! k=p_FAST%nBeams - - END IF ! BeamDyn - !BeamDyn's first "state" is not actually the state. So, do we need to do something with that????? - - - !AeroDyn - !note: i'm skipping the (unused) TowerMotion mesh - AD%Input(1)%rotors(1)%HubMotion%TranslationDisp = 0.0 - AD%Input(1)%rotors(1)%HubMotion%Orientation = AD%Input(1)%rotors(1)%HubMotion%RefOrientation - AD%Input(1)%rotors(1)%HubMotion%RotationVel(1, :) = caseData%RotSpeed - AD%Input(1)%rotors(1)%HubMotion%RotationVel(2:3,:) = 0.0_ReKi - - DO k = 1,size(AD%Input(1)%rotors(1)%BladeRootMotion,1) - theta = EulerExtract(AD%Input(1)%rotors(1)%BladeRootMotion(k)%RefOrientation(:,:,1)) - theta(3) = -caseData%Pitch - AD%Input(1)%rotors(1)%BladeRootMotion(k)%Orientation(:,:,1) = EulerConstruct(theta) !AD%Input(1)%BladeRootMotion(k)%RefOrientation - - AD%Input(1)%rotors(1)%BladeMotion(k)%RotationVel = 0.0_ReKi - !AD%Input(1)%rotors(1)%BladeMotion(k)%RotationAcc = 0.0_ReKi - AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationAcc = 0.0_ReKi - END DO - - ! Set FlowField information -- AD calculates everything from the data stored in the FlowField pointer - AD%p%FlowField%Uniform%VelH(:) = caseData%WindSpeed - AD%p%FlowField%Uniform%LinShrV(:) = 0.0_ReKi - AD%p%FlowField%Uniform%AngleH(:) = 0.0_ReKi - AD%p%FlowField%PropagationDir = 0.0_ReKi - - AD%Input(1)%rotors(1)%UserProp = 0.0_ReKi - - -END SUBROUTINE SteadyStatePrescribedInputs -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE FormSteadyStateJacobian( caseData, Jmat, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat, ErrMsg ) - TYPE(FAST_SS_CaseType) , INTENT(IN ) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case - REAL(R8Ki), INTENT(INOUT) :: Jmat(:,:) !< temporary storage space for jacobian matrix - 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(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - - 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 - - - CHARACTER(1024) :: LinRootName - REAL(R8Ki), ALLOCATABLE :: dUdu(:,:) !< temporary storage space for jacobian matrix - REAL(R8Ki), ALLOCATABLE :: dUdy(:,:) !< temporary storage space for jacobian matrix - REAL(R8Ki), ALLOCATABLE :: dxdotdy(:,:) !< temporary storage space for jacobian matrix - - - INTEGER(IntKi) :: Un - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMSg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FormSteadyStateJacobian' - - ErrStat = ErrID_None - ErrMsg = "" - - Jmat = 0.0_R8Ki ! initialize everything we are not spec - Un = -1 - - ! these values may get printed in the linearization output files, so we'll set them here: - y_FAST%Lin%WindSpeed = caseData%WindSpeed - y_FAST%Lin%RotSpeed = caseData%RotSpeed - y_FAST%Lin%Azimuth = 0.0 - - LinRootName = TRIM(p_FAST%OutFileRoot)//'.'//trim(num2lstr(m_FAST%Lin%NextLinTimeIndx)) - - call GetModuleJacobians( caseData, dxdotdy, p_FAST, y_FAST, m_FAST, ED, BD, AD, LinRootName, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - - call GetGlueJacobians( dUdu, dUdy, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - - - if (output_debugging) then - call WrLinFile_txt_Head(SS_t_global, p_FAST, y_FAST, y_FAST%Lin%Glue, LinRootName, Un, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - - if (p_FAST%LinOutJac) then ! write these before they possibly get modified with LAPACK routines (in particular, dUdu) - call WrPartialMatrix( dUdu, Un, p_FAST%OutFmt, 'dUdu', UseRow=y_FAST%Lin%Glue%use_u, UseCol=y_FAST%Lin%Glue%use_u ) - call WrPartialMatrix( dUdy, Un, p_FAST%OutFmt, 'dUdy', UseRow=y_FAST%Lin%Glue%use_u, UseCol=y_FAST%Lin%Glue%use_y ) - call WrPartialMatrix( dxdotdy, Un, p_FAST%OutFmt, 'dxdotdy', UseRow=y_FAST%Lin%Glue%use_u, UseCol=y_FAST%Lin%Glue%use_y ) - end if - end if - - !----------------------------------------- - ! form J matrix - !----------------------------------------- - CALL GetBlock11(Jmat, dxdotdy, p_FAST, y_FAST, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL GetBlock12(Jmat, dxdotdy, p_FAST, y_FAST, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL GetBlock21(Jmat, dUdy, p_FAST, y_FAST, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL GetBlock22(Jmat, dUdy, dUdu, p_FAST, y_FAST, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - - - - if (output_debugging) then - if (p_FAST%LinOutJac) then - ! Jacobians - call WrPartialMatrix( Jmat, Un, p_FAST%OutFmt, 'J' ) - end if - - ! finish writing the file - call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Glue ) - end if - - m_FAST%Lin%NextLinTimeIndx = m_FAST%Lin%NextLinTimeIndx + 1 -CONTAINS - SUBROUTINE Cleanup() - - IF (ALLOCATED(dUdu)) DEALLOCATE(dUdu) - IF (ALLOCATED(dUdy)) DEALLOCATE(dUdy) - IF (ALLOCATED(dxdotdy)) DEALLOCATE(dxdotdy) - - if (Un > 0) close(Un) - - END SUBROUTINE Cleanup - -END SUBROUTINE FormSteadyStateJacobian -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE GetModuleJacobians( caseData, dxdotdy, p_FAST, y_FAST, m_FAST, ED, BD, AD, LinRootName, ErrStat, ErrMsg ) - TYPE(FAST_SS_CaseType) , INTENT(IN ) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case - REAL(R8Ki), ALLOCATABLE ,INTENT(INOUT) :: dxdotdy(:,:) !< temporary storage space for jacobian matrix - 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(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - CHARACTER(*), INTENT(IN ) :: LinRootName - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - REAL(R8Ki) :: OmegaSquared - INTEGER(IntKi) :: k - INTEGER(IntKi) :: i, r, c, nx - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMSg2 - CHARACTER(*), PARAMETER :: RoutineName = 'GetModuleJacobians' - - ErrStat = ErrID_None - ErrMsg = "" - - !------------------------ - ! dx_dot/dy: - !------------------------ - if (.not. allocated(dxdotdy)) then - call AllocAry(dxdotdy, y_FAST%Lin%Glue%SizeLin(LIN_ContState_COL), y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), 'dxdotdy', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - end if - - dxdotdy = 0.0_R8Ki - - !..................... - ! Structure - !..................... - - y_FAST%Lin%RotSpeed = ED%y%RotSpeed - y_FAST%Lin%Azimuth = ED%y%LSSTipPxa - - !..................... - ! ElastoDyn - !..................... - if ( p_FAST%CompElast == Module_ED ) then - ! get the jacobians - call ED_JacobianPInput( SS_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, 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( SS_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, 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 - if (output_debugging) then - call ED_GetOP( SS_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, 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) return - - ! write the module matrices: - call WriteModuleLinearMatrices(Module_ED, 1, SS_t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - end if - - !..................... - ! BeamDyn - !..................... - elseif ( p_FAST%CompElast == Module_BD ) then - - OmegaSquared = caseData%RotSpeed**2 - nx = size(dxdotdy,1)/2 - - do k=1,p_FAST%nBeams - - ! get the jacobians - call BD_JacobianPInput( SS_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(k), BD%m(k), ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%D, & - dXdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%B, & - StateRel_x =y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRel_x, & - StateRel_xdot=y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRel_xdot ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - call BD_JacobianPContState( SS_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(k), BD%m(k), ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_BD)%Instance(k)%C, dXdx=y_FAST%Lin%Modules(Module_BD)%Instance(k)%A, & - StateRotation=y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRotation) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - if (output_debugging) then - ! get the operating point (for writing to file only) - call BD_GetOP( SS_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(k), BD%m(k), ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_u, y_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_y, & - x_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_x, dx_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_dx ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) return - - ! write the module matrices: - call WriteModuleLinearMatrices(Module_BD, k, SS_t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - end if - - ! calculate dxdotdy here: - ! NOTE that this implies that the FEA nodes (states) are the same as the output nodes!!!! (note that we have overlapping nodes at the element end points) - r = 1 - do i=2,BD%p(k)%node_total ! the first node isn't technically a state - c = (BD%p(k)%NdIndx(i)-1)*3 + 1 ! BldMeshNode = BD%p(k)%NdIndx(i) - - !dxdotdy(r:r+2,c:c+2) = SkewSymMat( [p_FAST%RotSpeed, 0.0_ReKi, 0.0_ReKi] ) - dxdotdy(r+2,c+1) = caseData%RotSpeed - dxdotdy(r+1,c+2) = -caseData%RotSpeed - - ! derivative - dxdotdy(r+nx+1,c+1) = -OmegaSquared - dxdotdy(r+nx+2,c+2) = -OmegaSquared - - r = r + BD%p(k)%dof_node - end do - - end do ! k - - end if !BeamDyn - - - !..................... - ! AeroDyn - !..................... - if ( p_FAST%CompAero == Module_AD ) then - ! get the jacobians - call AD_JacobianPInput( SS_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) - - if (output_debugging) then - ! get the operating point - call AD_GetOP( SS_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, & - u_op=y_FAST%Lin%Modules(Module_AD)%Instance(1)%op_u, & - y_op=y_FAST%Lin%Modules(Module_AD)%Instance(1)%op_y ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) return - - - ! write the module matrices: - call WriteModuleLinearMatrices(Module_AD, 1, SS_t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) RETURN - end if - - end if - - ! move all module-level matrices into system-wide glue matrices: - call Glue_FormDiag( p_FAST, y_FAST, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - -END SUBROUTINE GetModuleJacobians -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE GetGlueJacobians( dUdu, dUdy, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat, ErrMsg ) - REAL(R8Ki), ALLOCATABLE, INTENT(INOUT) :: dUdu(:,:) !< temporary storage space for jacobian matrix - REAL(R8Ki), ALLOCATABLE, INTENT(INOUT) :: dUdy(:,:) !< temporary storage space for jacobian matrix - 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(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - - 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) :: ThisModule - INTEGER(IntKi) :: i, j - INTEGER(IntKi) :: k - INTEGER(IntKi) :: r_start, r_end - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMSg2 - CHARACTER(*), PARAMETER :: RoutineName = 'GetGlueJacobians' - - - ErrStat = ErrID_None - ErrMsg = "" - - !------------------------ - ! dU/du: - !------------------------ - if (.not. allocated(dUdu)) then - call AllocAry(dUdu, y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), 'dUdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - end if - - dUdu = 0.0_R8Ki ! most of this matrix is zero, so we'll just initialize everything and set only the non-zero parts below - do j = 1,p_FAST%Lin_NumMods - ThisModule = p_FAST%Lin_ModOrder(j) - do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) - r_start = y_FAST%Lin%Modules(ThisModule)%Instance(k)%LinStartIndx(LIN_INPUT_COL) - r_end = r_start + y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin( LIN_INPUT_COL) - 1 - do i = r_start,r_end - dUdu(i,i) = 1.0_R8Ki - end do - end do - end do - - - call LinearSS_AD_InputSolve_du( p_FAST, y_FAST, AD%Input(1), ED%y, BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - IF (p_FAST%CompElast == Module_ED) THEN - call LinearSS_ED_InputSolve_du( p_FAST, y_FAST, ED%Input(1), ED%y, AD%y, AD%Input(1), MeshMapData, dUdu, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ELSEIF (p_FAST%CompElast == Module_BD) THEN - call LinearSS_BD_InputSolve_du( p_FAST, y_FAST, AD%y, AD%Input(1), BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - END IF - -!!! write the module matrices: -!!!call WriteModuleLinearMatrices(Module_AD, 1, SS_t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) -!!! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) -!!! if (ErrStat >=AbortErrLev) RETURN - - !------------------------ - ! dU/dy: - !------------------------ - if (.not. allocated(dUdy)) then - call AllocAry(dUdy, y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), 'dUdy', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return - end if - - dUdy = 0.0_R8Ki ! most of this matrix is zero, so we'll just initialize everything and set only the non-zero parts below - - - if (p_FAST%CompElast == Module_ED) then - call LinearSS_ED_InputSolve_dy( p_FAST, y_FAST, ED%p, ED%Input(1), ED%y, AD%y, AD%Input(1), MeshMapData, dUdy, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - elseif (p_FAST%CompElast == MODULE_BD) then - call LinearSS_BD_InputSolve_dy( p_FAST, y_FAST, AD%y, AD%Input(1), BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - end if - - call LinearSS_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) - - - if (output_debugging) then - ! for debugging: - call Glue_GetOP(p_FAST, y_FAST, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) return - end if - -END SUBROUTINE GetGlueJacobians -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE GetBlock11(Jmat, dxdotdy, p_FAST, y_FAST, ErrStat, ErrMsg) - REAL(R8Ki), INTENT(INOUT) :: Jmat(:,:) !< Jacobian matrix of which we are calculating the upper left block: (1,1) - REAL(R8Ki), INTENT(IN ) :: dxdotdy(:,:) !< temporary storage space for jacobian matrix - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - REAL(R8Ki), ALLOCATABLE :: blockMat(:,:) - INTEGER(IntKi) :: r_start, c_start, r, c - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'GetBlock11' - - ErrStat = ErrID_None - ErrMsg = "" - - !--------------- - ! upper left corner of J matrix: size of A (uses only blade DOFs from the structural module) - !--------------- - call AllocAry(blockMat, y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), 'block matrix 1,1', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return - - blockMat = y_FAST%Lin%Glue%A ! copy this so we don't overwrite y_FAST%Lin%Glue%A here - call LAPACK_GEMM( 'N', 'N', -1.0_R8Ki, dxdotdy, y_FAST%Lin%Glue%C, 1.0_R8Ki, blockMat, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - r_start = 1 - c_start = 1 - - ! dX/dx - dx_dot/dy * dY/dx = A - dx_dot/dy * C: - do c=1,size( blockMat, 2) - do r=1,size( blockMat, 1) - Jmat(r_start + r - 1, c_start + c - 1) = blockMat(r,c) - end do - end do - - - if (allocated (blockMat)) deallocate(blockMat) - - -END SUBROUTINE GetBlock11 -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE GetBlock12(Jmat, dxdotdy, p_FAST, y_FAST, ErrStat, ErrMsg) - REAL(R8Ki), INTENT(INOUT) :: Jmat(:,:) !< Jacobian matrix of which we are calculating the upper right block: (1,2) - REAL(R8Ki), INTENT(IN ) :: dxdotdy(:,:) !< temporary storage space for jacobian matrix - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - REAL(R8Ki), ALLOCATABLE :: blockMat(:,:) - INTEGER(IntKi) :: r_start, c_start, r, c - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'GetBlock11' - - ErrStat = ErrID_None - ErrMsg = "" - - !--------------- - ! upper right corner of J matrix: size of B (uses only blade DOFs from the structural module) - !--------------- - call AllocAry(blockMat, y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), 'block matrix 1,2', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return - - blockMat = y_FAST%Lin%Glue%B ! copy this so we don't overwrite y_FAST%Lin%Glue%B here - call LAPACK_GEMM( 'N', 'N', -1.0_R8Ki, dxdotdy, y_FAST%Lin%Glue%D, 1.0_R8Ki, blockMat, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - r_start = 1 - c_start = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + 1 - - ! dX/du - dx_dot/dy * dY/du = B - dx_dot/dy * D: - do c=1,size( blockMat, 2) - do r=1,size( blockMat, 1) - Jmat(r_start + r - 1, c_start + c - 1) = blockMat(r,c) - end do - end do - - - if (allocated (blockMat)) deallocate(blockMat) - - -END SUBROUTINE GetBlock12 -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE GetBlock21(Jmat, dUdy, p_FAST, y_FAST, ErrStat, ErrMsg) - REAL(R8Ki), INTENT(INOUT) :: Jmat(:,:) !< Jacobian matrix of which we are calculating the lower left block: (2,1) - REAL(R8Ki), INTENT(IN ) :: dUdy(:,:) !< dUdy matrix - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - REAL(R8Ki), ALLOCATABLE :: dUdx(:,:) - INTEGER(IntKi) :: r_start, c_start, r, c - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'GetBlock21' - - ErrStat = ErrID_None - ErrMsg = "" - - !--------------- - ! lower left corner of J matrix: - !--------------- - call AllocAry(dUdx, y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), 'block matrix 2,1', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return - - call LAPACK_GEMM( 'N', 'N', 1.0_R8Ki, dUdy, y_FAST%Lin%Glue%C, 0.0_R8Ki, dUdx, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - r_start = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + 1 - c_start = 1 - - ! dU/dy * dY/dx: - do c=1,size( dUdx, 2) - do r=1,size( dUdx, 1) - Jmat(r_start + r - 1, c_start + c - 1) = dUdx(r,c) - end do - end do - - if (allocated (dUdx)) deallocate(dUdx) - -END SUBROUTINE GetBlock21 -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE GetBlock22(Jmat, dUdy, dUdu, p_FAST, y_FAST, ErrStat, ErrMsg) - REAL(R8Ki), INTENT(INOUT) :: Jmat(:,:) !< Jacobian matrix of which we are calculating the lower left block: (2,1) - REAL(R8Ki), INTENT(IN ) :: dUdy(:,:) !< dUdy matrix - REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< dUdu matrix (note that it is modified on exit of this routine!) - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: r_start, c_start, r, c - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'GetBlock22' - - ErrStat = ErrID_None - ErrMsg = "" - - !--------------- - ! lower right corner of J matrix: - !--------------- - call LAPACK_GEMM( 'N', 'N', 1.0_R8Ki, dUdy, y_FAST%Lin%Glue%D, 1.0_R8Ki, dUdu, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - r_start = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + 1 - c_start = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + 1 - - ! dU/du + dU/dy * dY/du: - do c=1,size( dUdu, 2) - do r=1,size( dUdu, 1) - Jmat(r_start + r - 1, c_start + c - 1) = dUdu(r,c) - end do - end do - - -END SUBROUTINE GetBlock22 -!---------------------------------------------------------------------------------------------------------------------------------- - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine forms the dU^{ED}/du^{BD} and dU^{ED}/du^{AD} blocks (ED row) of dUdu. (i.e., how do changes in the AD and BD inputs affect the ED inputs?) -SUBROUTINE LinearSS_ED_InputSolve_du( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, MeshMapData, dUdu, ErrStat, ErrMsg ) - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) - 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(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message - - ! local variables - INTEGER(IntKi) :: K ! Loops through blades - INTEGER(IntKi) :: AD_Start_Bl ! starting index of dUdu (column) where AD blade motion inputs are located - INTEGER(IntKi) :: ED_Start_mt ! starting index of dUdu (row) where ED blade/tower or hub moment inputs are located - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'LinearSS_ED_InputSolve_du' - - - ! Initialize error status - - ErrStat = ErrID_None - ErrMsg = "" - - !.......... - ! dU^{ED}/du^{AD} - !.......... - IF ( p_FAST%CompAero == Module_AD ) THEN - - ! ED inputs on blade from AeroDyn - IF (p_FAST%CompElast == Module_ED) THEN - - ED_Start_mt = y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - - DO K = 1,p_FAST%NumBl_Lin !we don't need all blades: SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) - ED_Start_mt = ED_Start_mt + u_ED%BladePtLoads(k)%NNodes*3 ! skip the forces on this blade - AD_Start_Bl = SS_Indx_u_AD_Blade_Start(u_AD, p_FAST, y_FAST, k) - - CALL Linearize_Line2_to_Point( y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), y_ED%BladeLn2Mesh(k) ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! AD is source in the mapping, so we want M_{uSm} - if (allocated(MeshMapData%AD_L_2_BDED_B(k)%dM%m_us )) then - call SetBlockMatrix( dUdu, MeshMapData%AD_L_2_BDED_B(k)%dM%m_us, ED_Start_mt, AD_Start_Bl ) - end if - - ! get starting index of next blade - ED_Start_mt = ED_Start_mt + u_ED%BladePtLoads(k)%NNodes* 3 ! skip the moments on this blade - - END DO - - END IF - - END IF - - -END SUBROUTINE LinearSS_ED_InputSolve_du -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine forms the dU^{BD}/du^{BD} and dU^{BD}/du^{AD} blocks (BD row) of dUdu. (i.e., how do changes in the AD and BD inputs -!! affect the BD inputs?) This should be called only when p_FAST%CompElast == Module_BD. -SUBROUTINE LinearSS_BD_InputSolve_du( p_FAST, y_FAST, y_AD, u_AD, BD, MeshMapData, dUdu, ErrStat, ErrMsg ) - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) - TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs - TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linerization) - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD data at t - - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message - - ! local variables - INTEGER(IntKi) :: k ! Loops through blades - INTEGER(IntKi) :: BD_Start ! starting index of dUdu (row) where BD inputs are located - INTEGER(IntKi) :: AD_Start ! starting index of dUdu (column) where AD inputs are located - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'LinearSS_BD_InputSolve_du' - - - ! Initialize error status - - ErrStat = ErrID_None - ErrMsg = "" - - !.......... - ! dU^{BD}/du^{AD} - !.......... - IF ( p_FAST%CompAero == Module_AD ) THEN - - ! BD inputs on blade from AeroDyn - - - if (p_FAST%BD_OutputSibling) then - - DO K = 1,p_FAST%NumBl_Lin !we don't need all blades: p_FAST%nBeams ! Loop through all blades - CALL Linearize_Line2_to_Line2( y_AD%rotors(1)%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), BD%y(k)%BldMotion ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END DO - - else - - DO K = 1,p_FAST%NumBl_Lin !we don't need all blades: p_FAST%nBeams ! Loop through all blades - !linearization for dUdy will need some matrix multiplies because of the transfer (chain rule!), but we will perform individual linearization calculations here - !!! need to transfer the BD output blade motions to nodes on a sibling of the BD blade motion mesh: - CALL Linearize_Line2_to_Line2( BD%y(k)%BldMotion, MeshMapData%y_BD_BldMotion_4Loads(k), MeshMapData%BD_L_2_BD_L(k), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL Linearize_Line2_to_Line2( y_AD%rotors(1)%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), MeshMapData%y_BD_BldMotion_4Loads(k) ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END DO - - end if - - - DO K = 1,p_FAST%NumBl_Lin !we don't need all blades: p_FAST%nBeams ! Loop through all blades - - ! AD is source in the mapping, so we want M_{uSm} - if (allocated(MeshMapData%AD_L_2_BDED_B(k)%dM%m_us )) then - AD_Start = SS_Indx_u_AD_Blade_Start(u_AD, p_FAST, y_FAST, k) ! index for the start of u_AD%BladeMotion(k)%translationDisp field - - BD_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_INPUT_COL) & - + BD%Input(1,k)%DistrLoad%NNodes * 3 ! force field for each node (start with moment field) - - call SetBlockMatrix( dUdu, MeshMapData%AD_L_2_BDED_B(k)%dM%m_us, BD_Start, AD_Start ) - end if - - END DO - - END IF - -END SUBROUTINE LinearSS_BD_InputSolve_du -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine forms the dU^{AD}/du^{AD} block of dUdu. (i.e., how do changes in the AD inputs affect the AD inputs?) -SUBROUTINE LinearSS_AD_InputSolve_du( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMapData, dUdu, ErrStat, ErrMsg ) - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) - TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn14 - TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< The outputs from the structural dynamics module - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD data at t - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block - INTEGER(IntKi), INTENT(INOUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT(INOUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! Local variables: - INTEGER(IntKi) :: K ! Loops through blades - INTEGER(IntKi) :: AD_Start_td ! starting index of dUdu (column) where AD translation displacements are located - INTEGER(IntKi) :: AD_Start_tv ! starting index of dUdu (column) where AD translation velocities are located - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'LinearSS_AD_InputSolve_du' - - - ErrStat = ErrID_None - ErrMsg = "" - - ! note that we assume this block matrix has been initialized to the identity matrix before calling this routine - - ! look at how the translational displacement gets transfered to the translational velocity: - !------------------------------------------------------------------------------------------------- - ! Set the inputs from ElastoDyn and/or BeamDyn: - !------------------------------------------------------------------------------------------------- - - ! blades - IF (p_FAST%CompElast == Module_ED ) THEN - - DO k=1,p_FAST%NumBl_Lin !we don't need all blades: size(u_AD%BladeMotion) - CALL Linearize_Line2_to_Line2( y_ED%BladeLn2Mesh(k), u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeMotion('//trim(num2lstr(k))//')' ) - END DO - - ELSEIF (p_FAST%CompElast == Module_BD ) THEN - - DO k=1,p_FAST%NumBl_Lin !we don't need all blades: size(u_AD%BladeMotion) - CALL Linearize_Line2_to_Line2( BD%y(k)%BldMotion, u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeMotion('//trim(num2lstr(k))//')' ) - END DO - - END IF - - - - DO k=1,p_FAST%NumBl_Lin !we don't need all blades: size(u_AD%BladeMotion) - - AD_Start_td = SS_Indx_u_AD_Blade_Start(u_AD, p_FAST, y_FAST, k) ! index for u_AD%BladeMotion(k)%translationDisp field - - !AD is the destination here, so we need tv_ud - if (allocated( MeshMapData%BDED_L_2_AD_L_B(k)%dM%tv_ud)) then - ! index for u_AD%BladeMotion(k+1)%translationVel field - AD_Start_tv = AD_Start_td + u_AD%rotors(1)%BladeMotion(k)%NNodes * 6 ! 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field - - call SetBlockMatrix( dUdu, MeshMapData%BDED_L_2_AD_L_B(k)%dM%tv_ud, AD_Start_tv, AD_Start_td ) - end if - - - END DO - - - -END SUBROUTINE LinearSS_AD_InputSolve_du - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine forms the dU^{ED}/dy^{SrvD}, dU^{ED}/dy^{ED}, dU^{ED}/dy^{BD}, dU^{ED}/dy^{AD}, dU^{ED}/dy^{HD}, and dU^{ED}/dy^{MAP} -!! blocks of dUdy. (i.e., how do changes in the SrvD, ED, BD, AD, HD, and MAP outputs effect the ED inputs?) -SUBROUTINE LinearSS_ED_InputSolve_dy( p_FAST, y_FAST, p_ED, u_ED, y_ED, y_AD, u_AD, MeshMapData, dUdy, ErrStat, ErrMsg ) - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) - TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ElastoDyn parameters - 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(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message - - ! local variables - INTEGER(IntKi) :: K ! Loops through blades - INTEGER(IntKi) :: AD_Out_Start ! starting index of dUdy (column) where particular AD fields are located - INTEGER(IntKi) :: ED_Start ! starting index of dUdy (row) where ED input fields are located - INTEGER(IntKi) :: ED_Out_Start ! starting index of dUdy (column) where ED output fields are located - CHARACTER(*), PARAMETER :: RoutineName = 'Linear_ED_InputSolve_dy' - - - ! Initialize error status - - ErrStat = ErrID_None - ErrMsg = "" - - ! parts of dU^{ED}/dy^{AD} and dU^{ED}/dy^{ED}: - - ! ElastoDyn inputs on blade from AeroDyn and ElastoDyn - - AD_Out_Start = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) ! start of y_AD%rotors(1)%BladeLoad(1)%Force field [2 fields (force, moment) with 3 components] - - DO K = 1,p_FAST%NumBl_Lin !we don't need all blades: SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) - !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices - !!! ! while forming dUdy, too. - !CALL Linearize_Line2_to_Point( y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%BladeMotion(k), y_ED%BladeLn2Mesh(k) ) - - ! AD loads-to-ED loads transfer (dU^{ED}/dy^{AD}): - ED_Start = Indx_u_ED_Blade_Start(p_ED, u_ED, y_FAST, k) ! start of u_ED%BladePtLoads(k)%Force field - call Assemble_dUdy_Loads(y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ED_Start, AD_Out_Start, dUdy) - - ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): - ED_Start = Indx_u_ED_Blade_Start(p_ED, u_ED, y_FAST, k) + u_ED%BladePtLoads(k)%NNodes*3 ! start of u_ED%BladePtLoads(k)%Moment field (skip the ED forces) - ED_Out_Start = SS_Indx_y_ED_Blade_Start(y_ED, p_FAST, y_FAST, k) ! start of y_ED%BladeLn2Mesh(1)%TranslationDisp field - call SetBlockMatrix( dUdy, MeshMapData%AD_L_2_BDED_B(k)%dM%m_uD, ED_Start, ED_Out_Start ) - - AD_Out_Start = AD_Out_Start + y_AD%rotors(1)%BladeLoad(k)%NNodes*6 ! start of y_AD%rotors(1)%BladeLoad(k+1)%Force field [skip 2 fields to forces on next blade] - END DO - - -END SUBROUTINE LinearSS_ED_InputSolve_dy -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine forms the dU^{BD}/dy^{ED}, dU^{BD}/dy^{BD}, and dU^{BD}/dy^{AD} blocks of dUdy. (i.e., how do -!! changes in the ED, BD, and AD outputs effect the BD inputs?) -SUBROUTINE LinearSS_BD_InputSolve_dy( p_FAST, y_FAST, y_AD, u_AD, BD, MeshMapData, dUdy, ErrStat, ErrMsg ) - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) - TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs - 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 - REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message - - ! local variables - INTEGER(IntKi) :: K ! Loops through blades - INTEGER(IntKi) :: AD_Out_Start ! starting index of dUdy (column) where particular AD fields are located - INTEGER(IntKi) :: BD_Start ! starting index of dUdy (column) where particular BD fields are located - INTEGER(IntKi) :: BD_Out_Start ! starting index of dUdy (column) where BD output fields are located - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - REAL(R8Ki), ALLOCATABLE :: TempMat(:,:) ! temporary matrix for getting linearization matrices when BD input and output meshes are not siblings - CHARACTER(*), PARAMETER :: RoutineName = 'LinearSS_BD_InputSolve_dy' - - - ! Initialize error status - - ErrStat = ErrID_None - ErrMsg = "" - - ! parts of dU^{BD}/dy^{AD} and dU^{BD}/dy^{BD}: - - ! BeamDyn inputs on blade from AeroDyn and BeamDyn - - AD_Out_Start = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) ! start of y_AD%rotors(1)%BladeLoad(1)%Force field [2 fields (force, moment) with 3 components] - DO K = 1,p_FAST%NumBl_Lin !we don't need all blades: p_FAST%nBeams ! Loop through all blades - - BD_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_INPUT_COL) ! start of BD%Input(1,k)%DistrLoad%Force field - - ! AD loads-to-BD loads transfer (dU^{BD}/dy^{AD}): - call Assemble_dUdy_Loads(y_AD%rotors(1)%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), BD_Start, AD_Out_Start, dUdy) - AD_Out_Start = AD_Out_Start + y_AD%rotors(1)%BladeLoad(k)%NNodes*6 ! start of y_AD%rotors(1)%BladeLoad(k+1)%Force field [skip the moments to get to forces on next blade] - - - ! BD translation displacement-to-BD moment transfer (dU^{BD}/dy^{BD}): - BD_Start = BD_Start + BD%Input(1,k)%DistrLoad%NNodes * 3 ! start of BD%Input(1,k)%DistrLoad%Moment field (start with moment field) - BD_Out_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_OUTPUT_COL) ! start of BD%y(k)%BldMotion%TranslationDisp field - - - if (p_FAST%BD_OutputSibling) then - call SetBlockMatrix( dUdy, MeshMapData%AD_L_2_BDED_B(k)%dM%m_uD, BD_Start, BD_Out_Start ) - else - call AllocAry(TempMat, size(MeshMapData%AD_L_2_BDED_B(k)%dM%m_uD,1), size(MeshMapData%BD_L_2_BD_L(k)%dM%mi,2), 'TempMat', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat>=AbortErrLev) return - - ! these blocks should be small enough that we can use matmul instead of calling a LAPACK routine to do it. - TempMat = matmul(MeshMapData%AD_L_2_BDED_B(k)%dM%m_uD,MeshMapData%BD_L_2_BD_L(k)%dM%mi) - call SetBlockMatrix( dUdy, TempMat, BD_Start, BD_Out_Start ) - - BD_Out_Start = BD_Out_Start + BD%y(k)%BldMotion%NNodes*3 ! start of BD%y(k)%BldMotion%Orientation field - TempMat = matmul(MeshMapData%AD_L_2_BDED_B(k)%dM%m_uD,MeshMapData%BD_L_2_BD_L(k)%dM%fx_p) - call SetBlockMatrix( dUdy, TempMat, BD_Start, BD_Out_Start ) - - deallocate(TempMat) ! the next blade may have a different number of nodes - end if - - END DO - - -END SUBROUTINE LinearSS_BD_InputSolve_dy -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine forms the dU^{AD}/dy^{ED} and dU^{AD}/dy^{BD} blocks of dUdy. (i.e., how do changes in the ED and BD outputs affect -!! the AD inputs?) -SUBROUTINE LinearSS_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMapData, dUdy, ErrStat, ErrMsg ) - - ! Passed variables - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) - TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn14 - TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the structural dynamics module - TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BD data at t - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{AD}/dy^{ED} block - - INTEGER(IntKi) :: ErrStat !< Error status of the operation - CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! Local variables: - - INTEGER(IntKi) :: K ! Loops through blades - INTEGER(IntKi) :: AD_Start ! starting index of dUdy (column) where particular AD fields are located - INTEGER(IntKi) :: ED_Out_Start! starting index of dUdy (row) where particular ED fields are located - INTEGER(IntKi) :: BD_Out_Start! starting index of dUdy (row) where particular BD fields are located - LOGICAL :: FieldMask(FIELDMASK_SIZE) -! INTEGER(IntKi) :: ErrStat2 -! CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'LinearSS_AD_InputSolve_NoIfW_dy' - - - ErrStat = ErrID_None - ErrMsg = "" - - ! Only assemble from the following source fields - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_ORIENTATION) = .true. - FieldMask(MASKID_TRANSLATIONVEL) = .true. - FieldMask(MASKID_ROTATIONVEL) = .false. - FieldMask(MASKID_TRANSLATIONACC) = .false. - FieldMask(MASKID_ROTATIONACC) = .false. - - !------------------------------------------------------------------------------------------------- - ! Set the inputs from ElastoDyn and/or BeamDyn: - !------------------------------------------------------------------------------------------------- - !................................... - ! blades - !................................... - IF (p_FAST%CompElast == Module_ED ) THEN - - DO k=1,p_FAST%NumBl_Lin !we don't need all blades: size(y_ED%BladeLn2Mesh) - !!! ! This linearization was done in forming dUdu (see Linear_AD_InputSolve_du()), so we don't need to re-calculate these matrices - !!! ! while forming dUdy, too. - !!!CALL Linearize_Line2_to_Line2( y_ED%BladeLn2Mesh(k), u_AD%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) - - AD_Start = SS_Indx_u_AD_Blade_Start(u_AD, p_FAST, y_FAST, k) ! start of u_AD%BladeMotion(k)%TranslationDisp field - ED_Out_Start = SS_Indx_y_ED_Blade_Start(y_ED, p_FAST, y_FAST, k) ! start of y_ED%BladeLn2Mesh(k)%TranslationDisp field - CALL Assemble_dUdy_Motions(y_ED%BladeLn2Mesh(k), u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), AD_Start, ED_Out_Start, dUdy, FieldMask) - - END DO - - ELSEIF (p_FAST%CompElast == Module_BD ) THEN - !!! ! This linearization was done in forming dUdu (see Linear_AD_InputSolve_du()), so we don't need to re-calculate these matrices - !!! ! while forming dUdy, too. - !!!CALL Linearize_Line2_to_Line2( BD%y(k)%BldMotion, u_AD%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) - - DO k=1,p_FAST%NumBl_Lin !we don't need all blades: p_FAST%nBeams - AD_Start = SS_Indx_u_AD_Blade_Start(u_AD, p_FAST, y_FAST, k) ! start of u_AD%BladeMotion(k)%TranslationDisp field - BD_Out_Start = y_FAST%Lin%Modules(Module_BD)%Instance(k)%LinStartIndx(LIN_OUTPUT_COL) - - CALL Assemble_dUdy_Motions(BD%y(k)%BldMotion, u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), AD_Start, BD_Out_Start, dUdy, FieldMask) - END DO - - END IF - - -END SUBROUTINE LinearSS_AD_InputSolve_NoIfW_dy -!---------------------------------------------------------------------------------------------------------------------------------- - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine returns the starting index for the u_AD%BladeMotion(k) mesh in the FAST linearization inputs. -FUNCTION SS_Indx_u_AD_Blade_Start(u_AD, p_FAST, y_FAST, BladeNum) RESULT(AD_Start) - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) - TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD Inputs at t - INTEGER(IntKi), INTENT(IN ) :: BladeNum !< blade number to find index for - INTEGER :: k !< blade number loop - - INTEGER(IntKi) :: AD_Start !< starting index of this mesh in AeroDyn inputs - - AD_Start = y_FAST%Lin%Modules(Module_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - - do k = 1,min(BladeNum-1,p_FAST%NumBl_Lin) !size(u_AD%BladeMotion)) - AD_Start = AD_Start + u_AD%rotors(1)%BladeMotion(k)%NNodes * 9 ! 3 fields (TranslationDisp, MASKID_Orientation, TranslationVel) with 3 components - end do -END FUNCTION SS_Indx_u_AD_Blade_Start -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine returns the starting index for the y_ED%BladeLn2Mesh(BladeNum) mesh in the FAST linearization outputs. -FUNCTION SS_Indx_y_ED_Blade_Start(y_ED, p_FAST, y_FAST, BladeNum) RESULT(ED_Out_Start) - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) - TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ED outputs at t - INTEGER(IntKi), INTENT(IN ) :: BladeNum !< blade number to find index for - INTEGER :: k !< blade number loop - - INTEGER(IntKi) :: ED_Out_Start !< starting index of this blade mesh in ElastoDyn outputs - - ED_Out_Start = y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) ! start of y_ED%BladeLn2Mesh(1)%TranslationDisp field (blade motions in y_ED) - if (allocated(y_ED%BladeLn2Mesh)) then - do k = 1,min(BladeNum-1,p_FAST%NumBl_Lin) ! we don't need all blades: SIZE(y_ED%BladeLn2Mesh,1)) ! Loop through all blades (p_ED%NumBl) - ED_Out_Start = ED_Out_Start + y_ED%BladeLn2Mesh(k)%NNodes*12 ! 4 fields with 3 components on each blade - end do - end if - -END FUNCTION SS_Indx_y_ED_Blade_Start -!---------------------------------------------------------------------------------------------------------------------------------- - - - -END MODULE FAST_SS_Solver diff --git a/modules/openfast-library/src/FAST_SS_Subs.f90 b/modules/openfast-library/src/FAST_SS_Subs.f90 deleted file mode 100644 index c06c67beff..0000000000 --- a/modules/openfast-library/src/FAST_SS_Subs.f90 +++ /dev/null @@ -1,323 +0,0 @@ -!********************************************************************************************************************************** -! FAST_Solver.f90, FAST_Subs.f90, FAST_Lin.f90, and FAST_Mods.f90 make up the FAST glue code in the FAST Modularization Framework. -! FAST_Prog.f90, FAST_Library.f90, FAST_Prog.c are different drivers for this code. -!.................................................................................................................................. -! LICENSING -! Copyright (C) 2013-2016 National Renewable Energy Laboratory -! -! This file is part of FAST. -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! limitations under the License. -!********************************************************************************************************************************** -MODULE FAST_SS_Subs - - USE FAST_SS_Solver - - IMPLICIT NONE - - -CONTAINS -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -! DRIVER ROUTINE (runs + ends simulation) -! Put here so that we can call from either stand-alone code or from the ENFAST executable. -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - -SUBROUTINE FAST_RunSteadyStateDriver( Turbine ) - TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine - - INTEGER(IntKi) :: ErrStat !< Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ProgName = TRIM(FAST_Ver%Name)//' Steady State' - FAST_Ver%Name = ProgName - - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ! initialization - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - CALL FAST_InitializeSteadyState_T( Turbine, ErrStat, ErrMsg ) - CALL CheckError( ErrStat, ErrMsg, 'during module initialization' ) - - - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ! Calculate steady-state solutions: - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - CALL FAST_SteadyState_T( Turbine, ErrStat, ErrMsg ) - CALL CheckError( ErrStat, ErrMsg, 'during steady-state solve' ) - - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ! Clean up and stop - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - CALL ExitThisProgram_T( Turbine, ErrID_None, .true. ) - - CONTAINS - !............................................................................................................................... - SUBROUTINE CheckError(ErrID,Msg,SimMsg) - ! This subroutine sets the error message and level and cleans up if the error is >= AbortErrLev - !............................................................................................................................... - - ! Passed arguments - INTEGER(IntKi), INTENT(IN) :: ErrID ! The error identifier (ErrStat) - CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) - CHARACTER(*), INTENT(IN) :: SimMsg ! a message describing the location of the error - - IF ( ErrID /= ErrID_None ) THEN - CALL WrScr( NewLine//TRIM(Msg)//NewLine ) - - IF ( ErrID >= AbortErrLev ) THEN - CALL ExitThisProgram_T( Turbine, ErrID, .true., SimMsg ) - END IF - - END IF - - END SUBROUTINE CheckError -END SUBROUTINE FAST_RunSteadyStateDriver -!---------------------------------------------------------------------------------------------------------------------------------- - -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -! INITIALIZATION ROUTINES -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -SUBROUTINE FAST_InitializeSteadyState_T( Turbine, ErrStat, ErrMsg ) - TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - LOGICAL, PARAMETER :: CompAeroMaps = .true. - REAL(DbKi), PARAMETER :: t_initial = 0.0_DbKi - - Turbine%TurbID = 1 - - CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg ) - - call InitFlowField() - -contains - !> AD15 now directly accesses FlowField data from IfW. Since we don't use IfW, we need to manually set the FlowField data - !! NOTE: we deallocate(AD%p%FlowField) at the end of the simulation if CompAeroMaps is true - subroutine InitFlowField() - use InflowWind_IO, only: IfW_SteadyWind_Init - use InflowWind_IO_Types, only: InflowWind_IO_DestroySteady_InitInputType, InflowWind_IO_DestroyWindFileDat - type(Steady_InitInputType) :: InitInp - integer(IntKi) :: SumFileUnit = -1 - type(WindFileDat) :: WFileDat ! throw away data returned form init - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - allocate(Turbine%AD%p%FlowField) - Turbine%AD%p%FlowField%FieldType = 1 ! Steady wind, init below. - InitInp%RefHt = 100.0_ReKi ! Any value will do here. No exponent, so this doesn't matter - InitInp%HWindSpeed = 8.0_ReKi ! This gets overwritten later before used - InitInp%PLExp = 0.0_ReKi ! no shear used - call IfW_SteadyWind_Init(InitInp, SumFileUnit, Turbine%AD%p%FlowField%Uniform, WFileDat, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'FAST_InitializeSteadyState_T:InitFlowField') - if (ErrStat >= AbortErrLev) deallocate(Turbine%AD%p%FlowField) - - call InflowWind_IO_DestroySteady_InitInputType(InitInp, ErrStat2, ErrMsg2) ! ignore errors here because I'm lazy - call InflowWind_IO_DestroyWindFileDat(WFileDat, ErrStat2, ErrMsg2) ! ignore errors here because I'm lazy - end subroutine -END SUBROUTINE FAST_InitializeSteadyState_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls FAST_Solution 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. -SUBROUTINE FAST_SteadyState_T( Turbine, ErrStat, ErrMsg ) - - TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - CALL FAST_SteadyState( Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%AD, Turbine%MeshMapData, ErrStat, ErrMsg ) - -END SUBROUTINE FAST_SteadyState_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine takes data from n_t_global and gets values at n_t_global + 1 -SUBROUTINE FAST_SteadyState(p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, 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 - 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(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - - 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) :: n_case !< loop counter - REAL(DbKi) :: n_global - REAL(ReKi), ALLOCATABLE :: UnusedAry(:) - REAL(R8Ki), ALLOCATABLE :: Jmat(:,:) - TYPE(FAST_SS_CaseType) :: caseData ! tsr, windSpeed, pitch, and rotor speed for this case - TYPE(FAST_SS_CaseType) :: caseData_try2 ! tsr, windSpeed, pitch, and rotor speed for this case (to try a different operating point first) - - INTEGER(IntKi) :: NStatus - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMSg2 - TYPE(IceD_OutputType), ALLOCATABLE :: y_IceD (:) !< IceDyn outputs (WriteOutput values are subset) - CHARACTER(MaxWrScrLen), PARAMETER :: BlankLine = " " - - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_SteadyState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL InitSSVariables(p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, JMat, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - ! how often do we inform the user which case we are on? - NStatus = min( 100, p_FAST%NumSSCases/100 + 1) ! at least 100 every 100 cases or 100 times per simulation - call WrScr(NewLine) - - DO n_case = 1, p_FAST%NumSSCases - - if (mod(n_case,NStatus) == 0 .or. n_case==p_FAST%NumSSCases .or. n_case==1) then - call WrOver( ' Case '//trim(num2lstr(n_case))//' of '//trim(num2lstr(p_FAST%NumSSCases)) ) - end if - - - if (p_FAST%WindSpeedOrTSR==1) then - caseData%windSpeed = p_FAST%WS_TSR(n_case) - caseData%tsr = p_FAST%RotSpeed(n_case) * AD%p%rotors(1)%BEMT%rTipFixMax / caseData%windSpeed - else - caseData%tsr = p_FAST%WS_TSR(n_case) - caseData%windSpeed = p_FAST%RotSpeed(n_case) * AD%p%rotors(1)%BEMT%rTipFixMax / caseData%tsr - end if - caseData%pitch = p_FAST%Pitch(n_case) - caseData%RotSpeed = p_FAST%RotSpeed(n_case) - - ! Call steady-state solve for this pitch and rotor speed - call SolveSteadyState(caseData, Jmat, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat2, ErrMsg2) - - if (ErrStat2 >= ErrID_Severe) then - ! we didn't converge; let's try a different operating point and see if that helps: - caseData_try2%RotSpeed = caseData%RotSpeed - caseData_try2%Pitch = caseData%Pitch * 0.5_ReKi - caseData_try2%TSR = caseData%TSR * 0.5_ReKi - caseData_try2%WindSpeed = caseData%WindSpeed * 0.5_ReKi - - call WrScr('Retrying case '//trim(num2lstr(n_case))//', first trying to get a better initial guess. Average error is '// & - trim(num2lstr(y_FAST%DriverWriteOutput(SS_Indx_Err)))//'.') - call SolveSteadyState(caseData_try2, Jmat, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat2, ErrMsg2) - - ! if that worked, try the real case again: - if (ErrStat2 < AbortErrLev) then - call SolveSteadyState(caseData, Jmat, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat2, ErrMsg2) - call WrOver(BlankLine) - end if - - end if - - if (ErrStat2 > ErrID_None) then - ErrMsg2 = trim(ErrMsg2)//" case "//trim(num2lstr(n_case))//& - ' (tsr='//trim(num2lstr(caseData%tsr))//& - ', wind speed='//trim(num2lstr(caseData%windSpeed))//' m/s'//& - ', pitch='//trim(num2lstr(caseData%pitch*R2D))//' deg'//& - ', rotor speed='//trim(num2lstr(caseData%RotSpeed*RPS2RPM))//' rpm)' - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end if - - !---------------------------------------------------------------------------------------- - ! Write results to file - !---------------------------------------------------------------------------------------- - n_global = real(n_case, DbKi) ! n_global is double-precision so that we can reuse existing code. - - CALL WrOutputLine( n_global, p_FAST, y_FAST, UnusedAry, UnusedAry, ED%y%WriteOutput, UnusedAry, & - AD%y, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, & - UnusedAry, UnusedAry, UnusedAry, UnusedAry, y_IceD, BD%y, ErrStat2, ErrMsg2 ) - - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - - ! in case we have a lot of error messages, let's print the non fatal ones here: - if (ErrStat > ErrID_None) then - call WrScr(trim(ErrMsg)) - call WrScr("") - ErrStat = ErrID_None - ErrMsg = "" - end if - - END DO - -CONTAINS - SUBROUTINE Cleanup() - if (allocated(Jmat)) deallocate(Jmat) - END SUBROUTINE Cleanup - - -END SUBROUTINE FAST_SteadyState -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE InitSSVariables(p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, JMat, 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 - 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(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - REAL(R8Ki), ALLOCATABLE , INTENT(INOUT) :: Jmat(:,:) !< Matrix for storing Jacobian - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: NumBlades !< number of blades - - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMSg2 - - CHARACTER(*), PARAMETER :: RoutineName = 'SS_InitVariables' - - ErrStat = ErrID_None - ErrMsg = "" - - NumBlades = size(AD%y%rotors(1)%BladeLoad) - - - call AllocAry(Jmat, p_FAST%SizeJac_Opt1(1), p_FAST%SizeJac_Opt1(1), 'Jmat', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL AllocAry( MeshMapData%Jacobian_pivot, p_FAST%SizeJac_Opt1(1), 'Pivot array for Jacobian LU decomposition', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - !CALL AllocAry( MeshMapData%HubOrient, 3, 3, NumBlades, 'Hub orientation matrix', ErrStat2, ErrMsg2 ) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - if (ErrStat >= AbortErrLev) return - - - CALL CopyStatesInputs( p_FAST, ED, BD, AD, ErrStat2, ErrMsg2, MESH_NEWCOPY ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - -END SUBROUTINE InitSSVariables -!---------------------------------------------------------------------------------------------------------------------------------- -END MODULE FAST_SS_Subs -!---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/openfast-library/src/FAST_Solver.f90 b/modules/openfast-library/src/FAST_Solver.f90 index 90d292fe79..243e0b8307 100644 --- a/modules/openfast-library/src/FAST_Solver.f90 +++ b/modules/openfast-library/src/FAST_Solver.f90 @@ -5786,7 +5786,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, SED, B n_t_module = n_t_global*p_FAST%n_substeps( Module_BD ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( Module_BD ) + t_initial - CALL BD_UpdateStates( t_module, n_t_module, BD%Input(:,k), BD%InputTimes(:,k), BD%p(k), BD%x(k,STATE_PRED), & + CALL BD_UpdateStates( t_module, n_t_module, BD%Input(1:,k), BD%InputTimes(:,k), BD%p(k), BD%x(k,STATE_PRED), & BD%xd(k,STATE_PRED), BD%z(k,STATE_PRED), BD%OtherSt(k,STATE_PRED), BD%m(k), ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':B'//trim(num2lstr(k))) END DO !j_ss @@ -5817,7 +5817,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, SED, B ! n_t_module = n_t_global*p_FAST%n_substeps( MODULE_IfW ) + j_ss - 1 ! t_module = n_t_module*p_FAST%dt_module( MODULE_IfW ) + t_initial ! -! CALL InflowWind_UpdateStates( t_module, n_t_module, IfW%Input, IfW%InputTimes, IfW%p, IfW%x(STATE_PRED), IfW%xd(STATE_PRED), & +! CALL InflowWind_UpdateStates( t_module, n_t_module, IfW%Input(1:), IfW%InputTimes, IfW%p, IfW%x(STATE_PRED), IfW%xd(STATE_PRED), & ! IfW%z(STATE_PRED), IfW%OtherSt(STATE_PRED), IfW%m, ErrStat2, ErrMsg2 ) ! CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! END DO !j_ss @@ -5843,7 +5843,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, SED, B n_t_module = n_t_global*p_FAST%n_substeps( MODULE_AD ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( MODULE_AD ) + t_initial - CALL AD_UpdateStates( t_module, n_t_module, AD%Input, AD%InputTimes, AD%p, AD%x(STATE_PRED), & + CALL AD_UpdateStates( t_module, n_t_module, AD%Input(1:), AD%InputTimes, AD%p, AD%x(STATE_PRED), & AD%xd(STATE_PRED), AD%z(STATE_PRED), AD%OtherSt(STATE_PRED), AD%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO !j_ss @@ -5885,7 +5885,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, SED, B n_t_module = n_t_global*p_FAST%n_substeps( Module_SrvD ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( Module_SrvD ) + t_initial - CALL SrvD_UpdateStates( t_module, n_t_module, SrvD%Input, SrvD%InputTimes, SrvD%p, SrvD%x(STATE_PRED), SrvD%xd(STATE_PRED), & + CALL SrvD_UpdateStates( t_module, n_t_module, SrvD%Input(1:), 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 @@ -5908,7 +5908,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, SED, B n_t_module = n_t_global*p_FAST%n_substeps( Module_HD ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( Module_HD ) + t_initial - CALL HydroDyn_UpdateStates( t_module, n_t_module, HD%Input, HD%InputTimes, HD%p, HD%x(STATE_PRED), HD%xd(STATE_PRED), & + CALL HydroDyn_UpdateStates( t_module, n_t_module, HD%Input(1:), HD%InputTimes, HD%p, HD%x(STATE_PRED), HD%xd(STATE_PRED), & HD%z(STATE_PRED), HD%OtherSt(STATE_PRED), HD%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO !j_ss @@ -5931,7 +5931,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, SED, B n_t_module = n_t_global*p_FAST%n_substeps( Module_SD ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( Module_SD ) + t_initial - CALL SD_UpdateStates( t_module, n_t_module, SD%Input, SD%InputTimes, SD%p, SD%x(STATE_PRED), SD%xd(STATE_PRED), & + CALL SD_UpdateStates( t_module, n_t_module, SD%Input(1:), SD%InputTimes, SD%p, SD%x(STATE_PRED), SD%xd(STATE_PRED), & SD%z(STATE_PRED), SD%OtherSt(STATE_PRED), SD%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO !j_ss @@ -5950,7 +5950,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, SED, B n_t_module = n_t_global*p_FAST%n_substeps( Module_ExtPtfm ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( Module_ExtPtfm ) + t_initial - CALL ExtPtfm_UpdateStates( t_module, n_t_module, ExtPtfm%Input, ExtPtfm%InputTimes, ExtPtfm%p, ExtPtfm%x(STATE_PRED), & + CALL ExtPtfm_UpdateStates( t_module, n_t_module, ExtPtfm%Input(1:), ExtPtfm%InputTimes, ExtPtfm%p, ExtPtfm%x(STATE_PRED), & ExtPtfm%xd(STATE_PRED), ExtPtfm%z(STATE_PRED), ExtPtfm%OtherSt(STATE_PRED), ExtPtfm%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO !j_ss @@ -5974,7 +5974,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, SED, B n_t_module = n_t_global*p_FAST%n_substeps( Module_MAP ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( Module_MAP ) + t_initial - CALL MAP_UpdateStates( t_module, n_t_module, MAPp%Input, MAPp%InputTimes, MAPp%p, MAPp%x(STATE_PRED), MAPp%xd(STATE_PRED), MAPp%z(STATE_PRED), MAPp%OtherSt, ErrStat2, ErrMsg2 ) + CALL MAP_UpdateStates( t_module, n_t_module, MAPp%Input(1:), MAPp%InputTimes, MAPp%p, MAPp%x(STATE_PRED), MAPp%xd(STATE_PRED), MAPp%z(STATE_PRED), MAPp%OtherSt, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO !j_ss @@ -5992,7 +5992,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, SED, B n_t_module = n_t_global*p_FAST%n_substeps( Module_MD ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( Module_MD ) + t_initial - CALL MD_UpdateStates( t_module, n_t_module, MD%Input, MD%InputTimes, MD%p, MD%x(STATE_PRED), MD%xd(STATE_PRED), & + CALL MD_UpdateStates( t_module, n_t_module, MD%Input(1:), MD%InputTimes, MD%p, MD%x(STATE_PRED), MD%xd(STATE_PRED), & MD%z(STATE_PRED), MD%OtherSt(STATE_PRED), MD%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO !j_ss @@ -6011,7 +6011,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, SED, B n_t_module = n_t_global*p_FAST%n_substeps( Module_FEAM ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( Module_FEAM ) + t_initial - CALL FEAM_UpdateStates( t_module, n_t_module, FEAM%Input, FEAM%InputTimes, FEAM%p, FEAM%x(STATE_PRED), FEAM%xd(STATE_PRED), & + CALL FEAM_UpdateStates( t_module, n_t_module, FEAM%Input(1:), FEAM%InputTimes, FEAM%p, FEAM%x(STATE_PRED), FEAM%xd(STATE_PRED), & FEAM%z(STATE_PRED), FEAM%OtherSt(STATE_PRED), FEAM%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO !j_ss @@ -6030,7 +6030,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, SED, B n_t_module = n_t_global*p_FAST%n_substeps( Module_Orca ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( Module_Orca ) + t_initial - CALL Orca_UpdateStates( t_module, n_t_module, Orca%Input, Orca%InputTimes, Orca%p, Orca%x(STATE_PRED), & + CALL Orca_UpdateStates( t_module, n_t_module, Orca%Input(1:), Orca%InputTimes, Orca%p, Orca%x(STATE_PRED), & Orca%xd(STATE_PRED), Orca%z(STATE_PRED), Orca%OtherSt(STATE_PRED), Orca%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO !j_ss @@ -6053,7 +6053,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, SED, B n_t_module = n_t_global*p_FAST%n_substeps( Module_IceF ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( Module_IceF ) + t_initial - CALL IceFloe_UpdateStates( t_module, n_t_module, IceF%Input, IceF%InputTimes, IceF%p, IceF%x(STATE_PRED), & + CALL IceFloe_UpdateStates( t_module, n_t_module, IceF%Input(1:), IceF%InputTimes, IceF%p, IceF%x(STATE_PRED), & IceF%xd(STATE_PRED), IceF%z(STATE_PRED), IceF%OtherSt(STATE_PRED), IceF%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO !j_ss @@ -6074,7 +6074,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, SED, B n_t_module = n_t_global*p_FAST%n_substeps( Module_IceD ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( Module_IceD ) + t_initial - CALL IceD_UpdateStates( t_module, n_t_module, IceD%Input(:,i), IceD%InputTimes(:,i), IceD%p(i), IceD%x(i,STATE_PRED), & + CALL IceD_UpdateStates( t_module, n_t_module, IceD%Input(1:,i), IceD%InputTimes(1:,i), IceD%p(i), IceD%x(i,STATE_PRED), & IceD%xd(i,STATE_PRED), IceD%z(i,STATE_PRED), IceD%OtherSt(i,STATE_PRED), IceD%m(i), ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO !j_ss @@ -6169,7 +6169,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, SED, BD, Sr DO k = 1,p_FAST%nBeams - CALL BD_Input_ExtrapInterp(BD%Input(:,k), BD%InputTimes(:,k), BD%u(k), t_global_next, ErrStat2, ErrMsg2) + CALL BD_Input_ExtrapInterp(BD%Input(1:,k), BD%InputTimes(1:,k), BD%u(k), t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of BD%Input @@ -6191,7 +6191,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, SED, BD, Sr ! AeroDyn IF ( (p_FAST%CompAero == Module_AD ) .or. (p_FAST%CompAero == Module_ExtLd ) ) THEN - CALL AD_Input_ExtrapInterp(AD%Input, AD%InputTimes, AD%u, t_global_next, ErrStat2, ErrMsg2) + CALL AD_Input_ExtrapInterp(AD%Input(1:), AD%InputTimes, AD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of AD%Input @@ -6230,7 +6230,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, SED, BD, Sr ! InflowWind IF ( p_FAST%CompInflow == Module_IfW ) THEN - CALL InflowWind_Input_ExtrapInterp(IfW%Input, IfW%InputTimes, IfW%u, t_global_next, ErrStat2, ErrMsg2) + CALL InflowWind_Input_ExtrapInterp(IfW%Input(1:), IfW%InputTimes, IfW%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of IfW%Input @@ -6251,7 +6251,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, SED, BD, Sr ! ServoDyn IF ( p_FAST%CompServo == Module_SrvD ) THEN - CALL SrvD_Input_ExtrapInterp(SrvD%Input, SrvD%InputTimes, SrvD%u, t_global_next, ErrStat2, ErrMsg2) + CALL SrvD_Input_ExtrapInterp(SrvD%Input(1:), SrvD%InputTimes, SrvD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of SrvD%Input @@ -6275,7 +6275,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, SED, BD, Sr ! HydroDyn IF ( p_FAST%CompHydro == Module_HD ) THEN - CALL HydroDyn_Input_ExtrapInterp(HD%Input, HD%InputTimes, HD%u, t_global_next, ErrStat2, ErrMsg2) + CALL HydroDyn_Input_ExtrapInterp(HD%Input(1:), HD%InputTimes, HD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of HD%Input @@ -6297,7 +6297,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, SED, BD, Sr ! SubDyn/ExtPtfm_MCKF IF ( p_FAST%CompSub == Module_SD ) THEN - CALL SD_Input_ExtrapInterp(SD%Input, SD%InputTimes, SD%u, t_global_next, ErrStat2, ErrMsg2) + CALL SD_Input_ExtrapInterp(SD%Input(1:), SD%InputTimes, SD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of SD%Input @@ -6314,7 +6314,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, SED, BD, Sr ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN - CALL ExtPtfm_Input_ExtrapInterp(ExtPtfm%Input, ExtPtfm%InputTimes, ExtPtfm%u, t_global_next, ErrStat2, ErrMsg2) + CALL ExtPtfm_Input_ExtrapInterp(ExtPtfm%Input(1:), ExtPtfm%InputTimes, ExtPtfm%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of ExtPtfm%Input @@ -6335,7 +6335,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, SED, BD, Sr ! MAP IF ( p_FAST%CompMooring == Module_MAP ) THEN - CALL MAP_Input_ExtrapInterp(MAPp%Input, MAPp%InputTimes, MAPp%u, t_global_next, ErrStat2, ErrMsg2) + CALL MAP_Input_ExtrapInterp(MAPp%Input(1:), MAPp%InputTimes, MAPp%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of MAPp%Input @@ -6353,7 +6353,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, SED, BD, Sr ! MoorDyn ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN - CALL MD_Input_ExtrapInterp(MD%Input, MD%InputTimes, MD%u, t_global_next, ErrStat2, ErrMsg2) + CALL MD_Input_ExtrapInterp(MD%Input(1:), MD%InputTimes, MD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of MD%Input @@ -6371,7 +6371,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, SED, BD, Sr ! FEAM ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN - CALL FEAM_Input_ExtrapInterp(FEAM%Input, FEAM%InputTimes, FEAM%u, t_global_next, ErrStat2, ErrMsg2) + CALL FEAM_Input_ExtrapInterp(FEAM%Input(1:), FEAM%InputTimes, FEAM%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of FEAM%Input @@ -6389,7 +6389,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, SED, BD, Sr ! OrcaFlex ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN - CALL Orca_Input_ExtrapInterp(Orca%Input, Orca%InputTimes, Orca%u, t_global_next, ErrStat2, ErrMsg2) + CALL Orca_Input_ExtrapInterp(Orca%Input(1:), Orca%InputTimes, Orca%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of Orca%Input @@ -6412,7 +6412,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, SED, BD, Sr ! IceFloe IF ( p_FAST%CompIce == Module_IceF ) THEN - CALL IceFloe_Input_ExtrapInterp(IceF%Input, IceF%InputTimes, IceF%u, t_global_next, ErrStat2, ErrMsg2) + CALL IceFloe_Input_ExtrapInterp(IceF%Input(1:), IceF%InputTimes, IceF%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of IceF%Input @@ -6432,7 +6432,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, SED, BD, Sr DO i = 1,p_FAST%numIceLegs - CALL IceD_Input_ExtrapInterp(IceD%Input(:,i), IceD%InputTimes(:,i), IceD%u(i), t_global_next, ErrStat2, ErrMsg2) + CALL IceD_Input_ExtrapInterp(IceD%Input(1:,i), IceD%InputTimes(:,i), IceD%u(i), t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ! Shift "window" of IceD%Input diff --git a/modules/openfast-library/src/FAST_SolverTC.f90 b/modules/openfast-library/src/FAST_SolverTC.f90 new file mode 100644 index 0000000000..fe5a30331f --- /dev/null +++ b/modules/openfast-library/src/FAST_SolverTC.f90 @@ -0,0 +1,2164 @@ +module FAST_SolverTC + +use NWTC_LAPACK +use FAST_ModTypes +use FAST_Mapping +use FAST_ModGlue +use FAST_Funcs +use ElastoDyn +use BeamDyn +use SubDyn +use AeroDyn +use ServoDyn +use SC_DataEx + +implicit none + +private + +! Public functions +public FAST_SolverInit, FAST_SolverStep0, FAST_SolverStep, CalcOutputs_And_SolveForInputs + +! Debugging +logical, parameter :: DebugSolver = .false. +integer(IntKi) :: DebugUn = -1 +character(*), parameter :: DebugFile = 'solver.dbg' +logical, parameter :: DebugJacobian = .false. +integer(IntKi) :: MatrixUn = -1 + +contains + +subroutine FAST_SolverInit(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg) + type(FAST_ParameterType), intent(in) :: p_FAST !< FAST parameters + type(Glue_TCParam), intent(inout) :: p !< Glue Parameters + type(Glue_TCMisc), intent(out) :: m !< Glue miscellaneous variables + type(ModDataType), intent(inout) :: GlueModData(:) !< Glue module data + type(MappingType), intent(inout) :: GlueModMaps(:) !< Module mappings + type(FAST_TurbineType), intent(inout) :: Turbine !< all data for one instance of a turbine + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'Solver_Init' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, k + integer(IntKi), allocatable :: modIDs(:), modInds(:), iMod(:) + + !---------------------------------------------------------------------------- + ! Initialize data in TC structure + !---------------------------------------------------------------------------- + + ! Generalized alpha damping coefficient + p%RhoInf = p_FAST%RhoInf + + ! Max number of convergence iterations + p%MaxConvIter = p_FAST%MaxConvIter + + ! Convergence tolerance + p%ConvTol = p_FAST%ConvTol + + ! Solver time step + p%h = p_FAST%DT + + ! If time between Jacobian updates is less than the time step + if (p_FAST%DT_UJac < p_FAST%DT) then + p%NStep_UJac = huge(1_IntKi) ! Disable step based Jacobian updates + p%NIter_UJac = ceiling(p_FAST%DT_UJac/p_FAST%DT*real(p%MaxConvIter, R8Ki), IntKi) + else if (p_FAST%DT_UJac/p_FAST%DT + 1 < huge(1_IntKi)) then + p%NStep_UJac = ceiling(p_FAST%DT_UJac/p_FAST%DT, IntKi) + p%NIter_UJac = huge(1_IntKi) ! Disable iteration based Jacobian updates + else + p%NStep_UJac = huge(1_IntKi) ! Disable step based Jacobian updates + p%NIter_UJac = huge(1_IntKi) ! Disable iteration based Jacobian updates + end if + + ! Jacobian conditioning + p%Scale_UJac = p_FAST%UJacSclFact + + ! Generalized alpha integration constants + p%AlphaM = (2.0_R8Ki*p%RhoInf - 1.0_R8Ki)/(p%RhoInf + 1.0_R8Ki) + p%AlphaF = p%RhoInf/(p%RhoInf + 1.0_R8Ki) + p%Gamma = 0.5_R8Ki - p%AlphaM + p%AlphaF + p%Beta = (1.0_R8Ki - p%AlphaM + p%AlphaF)**2.0_R8Ki/4.0_R8Ki + + ! Precalculate some coefficients + p%BetaPrime = p%h*p%h*p%Beta*(1.0_R8Ki - p%AlphaF)/(1.0_R8Ki - p%AlphaM) + p%GammaPrime = p%h*p%Gamma*(1.0_R8Ki - p%AlphaF)/(1.0_R8Ki - p%AlphaM) + + !---------------------------------------------------------------------------- + ! Module ordering for solve + !---------------------------------------------------------------------------- + + ! Create array of indices for Mods array + modInds = [(i, i=1, size(GlueModData))] + + ! Get array of module IDs + modIDs = [(GlueModData(i)%ID, i=1, size(GlueModData))] + + ! Indices of all modules in Step 0 initialization order (SrvD inputs) + p%iModInit = [pack(modInds, ModIDs == Module_SED), & + pack(modInds, ModIDs == Module_ED), & + pack(modInds, ModIDs == Module_BD), & + pack(modInds, ModIDs == Module_SD), & + pack(modInds, ModIDs == Module_IfW), & + pack(modInds, ModIDs == Module_ExtInfw), & + pack(modInds, ModIDs == Module_ExtLd)] + + ! Indices of tight coupling modules + p%iModTC = [pack(modInds, ModIDs == Module_ED), & + pack(modInds, ModIDs == Module_BD), & + pack(modInds, ModIDs == Module_SD)] + + ! Indices of Option 1 modules + p%iModOpt1 = [pack(modInds, ModIDs == Module_SED), & + pack(modInds, ModIDs == Module_AD .and. p_FAST%MHK /= MHK_None), & + pack(modInds, ModIDs == Module_ExtPtfm), & + pack(modInds, ModIDs == Module_HD), & + pack(modInds, ModIDs == Module_MD), & + pack(modInds, ModIDs == Module_Orca)] + + ! Indices of Option 2 modules + p%iModOpt2 = [pack(modInds, ModIDs == Module_SrvD), & + pack(modInds, ModIDs == Module_SED), & + pack(modInds, ModIDs == Module_ED), & + pack(modInds, ModIDs == Module_BD), & + pack(modInds, ModIDs == Module_SD), & + pack(modInds, ModIDs == Module_IfW), & + pack(modInds, ModIDs == Module_SeaSt), & + pack(modInds, ModIDs == Module_AD .and. p_FAST%MHK == MHK_None), & + pack(modInds, ModIDs == Module_ADsk), & + pack(modInds, ModIDs == Module_ExtLd), & + pack(modInds, ModIDs == Module_FEAM), & + pack(modInds, ModIDs == Module_IceD), & + pack(modInds, ModIDs == Module_IceF), & + pack(modInds, ModIDs == Module_MAP)] + + ! Indices of modules to perform InputSolves after the Option 1 solve + p%iModPost = [pack(modInds, ModIDs == Module_SrvD), & + pack(modInds, ModIDs == Module_ExtInfw)] + + !---------------------------------------------------------------------------- + ! Set solve flags and combine relevant modules into TC module + !---------------------------------------------------------------------------- + + ! Set VF_Solve flag on Jacobian variables use by the tight coupling solver + call SetVarSolveFlags() + + ! Combination of TC and Option 1 module indices + iMod = [p%iModTC, p%iModOpt1] + + ! Build tight coupling module using solve variables from TC and Option 1 modules + call Glue_CombineModules(m%Mod, GlueModData, GlueModMaps, iMod, & + VF_Solve, .true., ErrStat2, ErrMsg2, Name='Solver') + if (Failed()) return + + !---------------------------------------------------------------------------- + ! Recalculate glue variable locations to simplify Jacobian construction + !---------------------------------------------------------------------------- + + call CalcVarGlobalIndices(p, m%Mod, p%NumQ, p%NumJ, ErrStat2, ErrMsg2) + if (Failed()) return + p%NumU = p%iJU(2) - p%iJU(2) + 1 + p%NumUT = p%iUT(2) - p%iUT(1) + 1 + + !---------------------------------------------------------------------------- + ! Initialize MiscVars + !---------------------------------------------------------------------------- + + ! Set flag to warn about convergence errors + m%ConvWarn = .true. + + ! Calculated inputs array + call AllocAry(m%uCalc, m%Mod%Vars%Nu, "m%uCalc", ErrStat2, ErrMsg2); if (Failed()) return + + ! Generalized alpha state arrays + call AllocAry(m%StateCurr%q_prev, p%NumQ, "m%StateCurr%q_prev", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%StateCurr%x, p%NumQ, "m%StateCurr%q_delta", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%StateCurr%q, p%NumQ, "m%StateCurr%q", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%StateCurr%v, p%NumQ, "m%StateCurr%v", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%StateCurr%vd, p%NumQ, "m%StateCurr%vd", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%StateCurr%a, p%NumQ, "m%StateCurr%a", ErrStat2, ErrMsg2); if (Failed()) return + m%StateCurr%q_prev = 0.0_R8Ki + m%StateCurr%x = 0.0_R8Ki + m%StateCurr%q = 0.0_R8Ki + m%StateCurr%v = 0.0_R8Ki + m%StateCurr%vd = 0.0_R8Ki + m%StateCurr%a = 0.0_R8Ki + + ! Allocate Jacobian matrix, RHS/X matrix, Pivot array + call AllocAry(m%J11, p%NumQ, p%NumQ, "m%J11", ErrStat, ErrMsg); if (Failed()) return + call AllocAry(m%J12, p%NumQ, p%NumUT, "m%J12", ErrStat, ErrMsg); if (Failed()) return + call AllocAry(m%J21, p%NumUT, p%NumQ, "m%J21", ErrStat, ErrMsg); if (Failed()) return + call AllocAry(m%J22, p%NumU, p%NumU, "m%J22", ErrStat, ErrMsg); if (Failed()) return + call AllocAry(m%Mod%Lin%J, p%NumJ, p%NumJ, "m%J", ErrStat, ErrMsg); if (Failed()) return + call AllocAry(m%XB, p%NumJ, 1, "m%XB", ErrStat, ErrMsg); if (Failed()) return + call AllocAry(m%IPIV, p%NumJ, "m%IPIV", ErrStat, ErrMsg); if (Failed()) return + m%Mod%Lin%J = 0.0_R8Ki + + !---------------------------------------------------------------------------- + ! Write debug info to file + !---------------------------------------------------------------------------- + + if (DebugSolver) then + call GetNewUnit(DebugUn, ErrStat2, ErrMsg2); if (Failed()) return + call OpenFOutFile(DebugUn, DebugFile, ErrStat2, ErrMsg2); if (Failed()) return + call Solver_Init_Debug(p, m, GlueModData, GlueModMaps) + end if + +contains + + ! SetVarSolveFlags adds the VF_Solve flags to variables in Option 1 modules + ! which need to be in the tight couping solver Jacobian. + subroutine SetVarSolveFlags() + logical :: SrcModTC, SrcModO1 + logical :: DstModTC, DstModO1 + logical :: HasSolveFlag + + ! Loop through tight coupling modules and add VF_Solve flag to continuous state variables + do i = 1, size(p%iModTC) + associate (ModData => GlueModData(p%iModTC(i))) + do j = 1, size(ModData%Vars%x) + call MV_SetFlags(ModData%Vars%x(j), VF_Solve) + end do + end associate + end do + + ! dUdu + ! VarsDst%u, VarDst(FieldTransDisp), VarsDst%u, VarDst(FieldTransVel) + ! VarsDst%u, VarDst(FieldTransDisp), VarsDst%u, VarDst(FieldTransAcc) + ! VarsSrc%u, VarSrcDisp(FieldTransDisp), VarsDst%u, VarDst(FieldMoment) + + ! dUdy Loads + ! VarsSrc%y, VarSrc(FieldForce), VarsDst%u, VarDst(FieldForce) + ! VarsSrc%y, VarSrc(FieldMoment), VarsDst%u, VarDst(FieldMoment) + ! VarsSrc%y, VarSrc(FieldForce), VarsDst%u, VarDst(FieldMoment) + ! VarsDst%y, VarDstDisp(FieldTransDisp), VarsDst%u, VarDst(FieldMoment) + ! VarsDst%y, VarDstDisp(FieldTransDisp), VarsDst%u, VarDst(FieldMoment) + ! VarsDst%y, VarDstDisp(FieldOrientation), VarsDst%u, VarDst(FieldMoment) + + ! dUdy Motions + ! VarsSrc%y, VarSrc(FieldTransDisp), VarsDst%u, VarDst(FieldTransDisp) + ! VarsSrc%y, VarSrc(FieldOrientation), VarsDst%u, VarDst(FieldOrientation) + ! VarsSrc%y, VarSrc(FieldTransVel), VarsDst%u, VarDst(FieldTransVel) + ! VarsSrc%y, VarSrc(FieldAngularVel), VarsDst%u, VarDst(FieldAngularVel) + ! VarsSrc%y, VarSrc(FieldTransAcc), VarsDst%u, VarDst(FieldTransAcc) + ! VarsSrc%y, VarSrc(FieldAngularAcc), VarsDst%u, VarDst(FieldAngularAcc) + ! VarsSrc%y, VarSrc(FieldOrientation), VarsDst%u, VarDst(FieldTransDisp) + ! VarsSrc%y, VarSrc(FieldAngularVel), VarsDst%u, VarDst(FieldTransVel) + ! VarsSrc%y, VarSrc(FieldAngularAcc), VarsDst%u, VarDst(FieldTransAcc) + ! VarsSrc%y, VarSrc(FieldTransDisp), VarsDst%u, VarDst(FieldTransVel) + ! VarsSrc%y, VarSrc(FieldTransDisp), VarsDst%u, VarDst(FieldTransAcc) + ! VarsSrc%y, VarSrc(FieldAngularVel), VarsDst%u, VarDst(FieldTransAcc) + + ! Loop through module mappings + do j = 1, size(GlueModMaps) + associate (Mapping => GlueModMaps(j), & + SrcMod => GlueModData(GlueModMaps(j)%iModSrc), & + DstMod => GlueModData(GlueModMaps(j)%iModDst)) + + ! Determine if source and destination modules are in tight coupling or Option 1 + SrcModTC = any(SrcMod%iMod == p%iModTC) + SrcModO1 = any(SrcMod%iMod == p%iModOpt1) + DstModTC = any(DstMod%iMod == p%iModTC) + DstModO1 = any(DstMod%iMod == p%iModOpt1) + + ! Select based on mapping type + select case (Mapping%MapType) + case (Map_MotionMesh) + + ! Add flag based on module locations + if (SrcModTC .and. DstModTC) then + + ! Add flag for source displacement, velocity, and acceleration + do i = 1, size(SrcMod%Vars%y) + associate (Var => SrcMod%Vars%y(i)) + if (MV_EqualDL(Mapping%SrcDL, Var%DL)) then + call MV_SetFlags(Var, VF_Solve) + end if + end associate + end do + + ! Add flag for destination displacement, velocity, and acceleration + do i = 1, size(DstMod%Vars%u) + associate (Var => DstMod%Vars%u(i)) + if (MV_EqualDL(Mapping%DstDL, Var%DL)) then + call MV_SetFlags(Var, VF_Solve) + end if + end associate + end do + + else if ((SrcModTC .and. DstModO1) .or. & + (SrcModO1 .and. DstModTC) .or. & + (SrcModO1 .and. DstModO1)) then + + ! Add flag for source displacement, velocity, acceleration for dUdy + do i = 1, size(SrcMod%Vars%y) + associate (Var => SrcMod%Vars%y(i)) + if (MV_EqualDL(Mapping%SrcDL, Var%DL)) then + call MV_SetFlags(Var, VF_Solve) + end if + end associate + end do + + ! Add flag for destination accelerations + do i = 1, size(DstMod%Vars%u) + associate (Var => DstMod%Vars%u(i)) + if (MV_EqualDL(Mapping%DstDL, Var%DL)) then + select case (Var%Field) + case (FieldTransAcc, FieldAngularAcc) + call MV_SetFlags(Var, VF_Solve) + end select + end if + end associate + end do + end if + + case (Map_LoadMesh) + + if (DstModTC .or. DstModO1) then + + ! Add flag to destination loads + do i = 1, size(DstMod%Vars%u) + associate (Var => DstMod%Vars%u(i)) + if (MV_EqualDL(Mapping%DstDL, Var%DL)) then + call MV_SetFlags(Var, VF_Solve) + end if + end associate + end do + + ! Add flag to destination displacements and orientations for dUdy + do i = 1, size(DstMod%Vars%y) + associate (Var => DstMod%Vars%y(i)) + if (MV_EqualDL(Mapping%DstDispDL, Var%DL)) then + select case (Var%Field) + case (FieldTransDisp, FieldOrientation) + call MV_SetFlags(Var, VF_Solve) + end select + end if + end associate + end do + + if ((SrcModTC .or. SrcModO1)) then + + ! Add flag to source loads + do i = 1, size(SrcMod%Vars%y) + associate (Var => SrcMod%Vars%y(i)) + if (MV_EqualDL(Mapping%SrcDL, Var%DL)) then + call MV_SetFlags(Var, VF_Solve) + end if + end associate + end do + + ! Add flag to source translation displacement for dUdu + do i = 1, size(SrcMod%Vars%u) + associate (Var => SrcMod%Vars%u(i)) + if (MV_EqualDL(Mapping%SrcDispDL, Var%DL)) then + select case (Var%Field) + case (FieldTransDisp) + call MV_SetFlags(Var, VF_Solve) + end select + end if + end associate + end do + + end if + + end if + + end select + + end associate + end do + + if (DebugSolver) then + do i = 1, size(GlueModData) + associate (ModData => GlueModData(i)) + if (allocated(ModData%Vars%u)) then + do j = 1, size(ModData%Vars%u) + associate (Var => ModData%Vars%u(j)) + if (MV_HasFlagsAny(Var, VF_Solve)) then + write (*, *) 'Solve u:', FAST_InputFieldName(ModData, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num + end if + end associate + end do + end if + if (allocated(ModData%Vars%y)) then + do j = 1, size(ModData%Vars%y) + associate (Var => ModData%Vars%y(j)) + if (MV_HasFlagsAny(Var, VF_Solve)) then + write (*, *) 'Solve y:', FAST_OutputFieldName(ModData, Var%DL)//' '//MV_FieldString(Var%Field), Var%Num + end if + end associate + end do + end if + end associate + end do + end if + + end subroutine + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine CalcVarGlobalIndices(p, ModTC, NumQ, NumJ, ErrStat, ErrMsg) + type(Glue_TCParam), intent(inout) :: p !< Parameters + type(ModGlueType), intent(inout) :: ModTC !< Module data + integer(IntKi), intent(out) :: NumJ !< Number of rows in Jacobian + integer(IntKi), intent(out) :: NumQ !< Number of rows in state matrix + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'CalcVarGlobalIndices' + integer(IntKi) :: ErrStat2 ! local error status + character(ErrMsgLen) :: ErrMsg2 ! local error message + integer(IntKi) :: i, j, k, num, iGlu + integer(IntKi) :: ix, iu, iy + + ErrStat = ErrID_None + ErrMsg = '' + + ! Initialize indices to zero + p%iX1 = 0 + p%iX2 = 0 + p%iUT = 0 + p%iU1 = 0 + p%iUL = 0 + p%iyT = 0 + p%iy1 = 0 + p%iJX = 0 + p%iJU = 0 + p%iJUT = 0 + p%iJL = 0 + + ! Loop through modules in data array and zero glue locations + do i = 1, size(ModTC%ModData) + associate (Vars => ModTC%ModData(i)%Vars) + if (allocated(Vars%x)) then + do j = 1, size(Vars%x) + Vars%x(j)%iGlu = 0 + end do + end if + if (allocated(Vars%u)) then + do j = 1, size(Vars%u) + Vars%u(j)%iGlu = 0 + end do + end if + if (allocated(Vars%y)) then + do j = 1, size(Vars%y) + Vars%y(j)%iGlu = 0 + end do + end if + end associate + end do + + !---------------------------------------------------------------------------- + ! Calculate TC state glue locations (displacements then velocities) + !---------------------------------------------------------------------------- + + ! Initialize glue index + iGlu = 0 + + ! Set indices for displacement variables + do i = 1, size(ModTC%ModData) + associate (Vars => ModTC%ModData(i)%Vars) + if (.not. allocated(Vars%x)) cycle + do j = 1, size(Vars%x) + if (Vars%x(j)%DerivOrder == 0) then + Vars%x(j)%iGlu = [iGlu + 1, iGlu + Vars%x(j)%Num] + iGlu = Vars%x(j)%iGlu(2) + end if + end do + end associate + end do + + ! Start and end indices of displacement variables + if (iGlu > 0) p%iX1 = [1, iGlu] + + ! Set indices for velocity variables + do i = 1, size(ModTC%ModData) + associate (Vars => ModTC%ModData(i)%Vars) + if (.not. allocated(Vars%x)) cycle + do j = 1, size(Vars%x) + if (Vars%x(j)%DerivOrder == 1) then + Vars%x(j)%iGlu = [iGlu + 1, iGlu + Vars%x(j)%Num] + iGlu = Vars%x(j)%iGlu(2) + end if + end do + end associate + end do + + ! Start and end indices of velocity variables + if (iGlu > p%iX1(2)) p%iX2 = [p%iX1(2) + 1, iGlu] + + !---------------------------------------------------------------------------- + ! Calculate input variable glue locations (group load and non-load) + !---------------------------------------------------------------------------- + + ! Initialize glue index + iGlu = 0 + + ! Set indices of Tight Coupling input variables (non-load) + do i = 1, size(p%iModTC) + associate (Vars => ModTC%ModData(i)%Vars) + if (.not. allocated(Vars%u)) cycle + do j = 1, size(Vars%u) + if (.not. MV_IsLoad(Vars%u(j))) then + Vars%u(j)%iGlu = [iGlu + 1, iGlu + Vars%u(j)%Num] + iGlu = Vars%u(j)%iGlu(2) + end if + end do + end associate + end do + + ! Set start index of load values + p%iUL(1) = iGlu + 1 + + ! Set indices of Tight Coupling input variables (load) + do i = 1, size(p%iModTC) + associate (Vars => ModTC%ModData(i)%Vars) + if (.not. allocated(Vars%u)) cycle + do j = 1, size(Vars%u) + if (MV_IsLoad(Vars%u(j))) then + Vars%u(j)%iGlu = [iGlu + 1, iGlu + Vars%u(j)%Num] + iGlu = Vars%u(j)%iGlu(2) + end if + end do + end associate + end do + + ! Set start/end indices for tight coupling inputs + if (iGlu > 0) p%iUT = [1, iGlu] + + ! Set indices of Option 1 input variables (load) + do i = size(p%iModTC) + 1, size(ModTC%ModData) + associate (Vars => ModTC%ModData(i)%Vars) + if (.not. allocated(Vars%u)) cycle + do j = 1, size(Vars%u) + if (MV_IsLoad(Vars%u(j))) then + Vars%u(j)%iGlu = [iGlu + 1, iGlu + Vars%u(j)%Num] + iGlu = Vars%u(j)%iGlu(2) + end if + end do + end associate + end do + + ! Set end index of load values + if (iGlu >= p%iUL(1)) p%iUL(2) = iGlu + + ! Set indices of Option 1 input variables (non-load) + do i = size(p%iModTC) + 1, size(ModTC%ModData) + associate (Vars => ModTC%ModData(i)%Vars) + if (.not. allocated(Vars%u)) cycle + do j = 1, size(Vars%u) + if (.not. MV_IsLoad(Vars%u(j))) then + Vars%u(j)%iGlu = [iGlu + 1, iGlu + Vars%u(j)%Num] + iGlu = Vars%u(j)%iGlu(2) + end if + end do + end associate + end do + + ! Set start/end indices for Option 1 inputs + if (iGlu > p%iUT(2)) p%iU1 = [p%iUT(2) + 1, iGlu] + + !---------------------------------------------------------------------------- + ! Calculate output variable categories and indices + !---------------------------------------------------------------------------- + + ! Initialize glue index + iGlu = 0 + + ! Set indices of Tight Coupling output variables + do i = 1, size(p%iModTC) + associate (Vars => ModTC%ModData(i)%Vars) + if (.not. allocated(Vars%y)) cycle + do j = 1, size(Vars%y) + Vars%y(j)%iGlu = [iGlu + 1, iGlu + Vars%y(j)%Num] + iGlu = Vars%y(j)%iGlu(2) + end do + end associate + end do + + ! Save number of tight coupling inputs + if (iGlu > 0) p%iyT = [1, iGlu] + + ! Set indices of Option 1 output variables + do i = size(p%iModTC) + 1, size(ModTC%ModData) + associate (Vars => ModTC%ModData(i)%Vars) + if (.not. allocated(Vars%y)) cycle + do j = 1, size(Vars%y) + Vars%y(j)%iGlu = [iGlu + 1, iGlu + Vars%y(j)%Num] + iGlu = Vars%y(j)%iGlu(2) + end do + end associate + end do + + ! Calculate number of option 1 outputs + if (iGlu > p%iyT(2)) p%iy1 = [p%iyT(2) + 1, iGlu] + + !---------------------------------------------------------------------------- + ! Allocate q storage for generalized alpha algorithm + ! This matrix stores equation state in an (N,4) array where: + ! - N is the number of equations (rows) + ! - Column 1 is position + ! - Column 2 is velocity + ! - Column 3 is acceleration + ! - Column 4 is generalized alpha algorithmic acceleration + !---------------------------------------------------------------------------- + + ! Initialize number of q states (ignore derivatives) + NumQ = 0 + + ! Loop through tight coupling modules in glue module + do i = 1, size(p%iModTC) + + associate (xVars => ModTC%ModData(i)%Vars%x) + + ! Loop through state variables + do j = 1, size(xVars) + + ! Skip variables which already have a q index + if (xVars(j)%iq(1) > 0) cycle + + ! Set q index for variable and update number + xVars(j)%iq = [NumQ + 1, NumQ + xVars(j)%Num] + NumQ = NumQ + xVars(j)%Num + + ! Loop through remaining vars if the names match + do k = j + 1, size(xVars) + + ! If names are different then they don't match, skip + if (xVars(j)%Name /= xVars(k)%Name) cycle + + ! If field is not the same or a derivative of current field, skip + select case (xVars(j)%Field) + case (FieldTransDisp, FieldTransVel, FieldTransAcc) + if (all(xVars(k)%Field /= TransFields)) cycle + case (FieldOrientation, FieldAngularDisp, FieldAngularVel, FieldAngularAcc) + if (all(xVars(k)%Field /= AngularFields)) cycle + case (FieldForce, FieldMoment) + cycle + end select + + ! Copy q row indices + xVars(k)%iq = xVars(j)%iq + + end do + end do + end associate + end do + + !---------------------------------------------------------------------------- + ! Populate combined variable arrays + !---------------------------------------------------------------------------- + + ix = 0; iu = 0; iy = 0 + do i = 1, size(ModTC%ModData) + associate (ModData => ModTC%ModData(i)) + + if (allocated(ModData%Vars%x)) then + do j = 1, size(ModData%Vars%x) + ix = ix + 1 + ModTC%Vars%x(ix)%iLoc = ModData%Vars%x(j)%iGlu + ModTC%Vars%x(ix)%iq = ModData%Vars%x(j)%iq + end do + end if + + if (allocated(ModData%Vars%u)) then + do j = 1, size(ModData%Vars%u) + iu = iu + 1 + ModTC%Vars%u(iu)%iLoc = ModData%Vars%u(j)%iGlu + end do + end if + + if (allocated(ModData%Vars%y)) then + do j = 1, size(ModData%Vars%y) + iy = iy + 1 + ModTC%Vars%y(iy)%iLoc = ModData%Vars%y(j)%iGlu + end do + end if + + end associate + end do + + !---------------------------------------------------------------------------- + ! Jacobian indices and ranges + !---------------------------------------------------------------------------- + + ! Calculate size of Jacobian matrix + NumJ = NumQ + ModTC%Vars%Nu + + ! Get start and end indices for state part of Jacobian + if (NumQ > 0) p%iJX = [1, NumQ] + + ! Get start and end indices for tight coupling input part of Jacobian + if (p%iUT(1) > 0) p%iJUT = NumQ + p%iUT + + ! Get start and end indices for input part of Jacobian + if (p%iUT(1) > 0 .or. p%iU1(2) > 0) p%iJU = NumQ + [1, max(p%iUT(2), p%iU1(2))] + + ! Get Jacobian indices containing loads + if (p%iUL(1) > 0) p%iJL = NumQ + p%iUL + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine FAST_SolverStep0(p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg) + type(Glue_TCParam), intent(in) :: p !< Parameters + type(Glue_TCMisc), intent(inout) :: m !< Misc variables + type(ModDataType), intent(inout) :: GlueModData(:) !< Glue module data + type(MappingType), intent(inout) :: GlueModMaps(:) !< Module mappings + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_SolverStep0' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, k + 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 + real(DbKi) :: t_global_next ! next simulation time + logical :: IsConverged + integer(IntKi) :: ConvIter, CorrIter, TotalIter + real(R8Ki) :: ConvError + real(R8Ki), allocatable :: Jac(:, :), XB(:, :) + + ErrStat = ErrID_None + ErrMsg = '' + + !---------------------------------------------------------------------------- + ! Miscellaneous initial step setup + !---------------------------------------------------------------------------- + + t_initial = Turbine%m_FAST%t_global + t_global_next = t_initial + n_t_global_next*p%h + + ! Initialize Jacobian update counters to zero to calculate on first iteration + m%UJacIterRemain = 0 + m%UJacStepsRemain = 0 + + !---------------------------------------------------------------------------- + ! Collect initial states from modules + !---------------------------------------------------------------------------- + + ! Transfer initial state from modules to solver + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + + ! Get continuous state operating points + call FAST_GetOP(ModData, t_initial, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + x_op=ModData%Lin%x, x_glue=m%Mod%Lin%x) + if (Failed()) return + + ! Transfer initial module state to GA state + call TransferXtoQ(ModData, m%Mod%Lin%x, m%StateCurr) + + ! Transfer accelerations from BeamDyn + if (ModData%ID == Module_BD) then + call GetBDAccel(ModData, Turbine%BD%OtherSt(ModData%Ins, STATE_CURR), m%StateCurr) + end if + + end associate + end do + + ! Initialize + m%StateCurr%q_prev = m%StateCurr%q + m%StateCurr%x = 0.0_R8Ki + + ! Reset mapping ready for transfer flag + call FAST_ResetMappingReady(GlueModMaps) + + ! Initialize temporary input structure for TC and Option1 modules + do i = 1, size(m%Mod%ModData) + call FAST_CopyInput(m%Mod%ModData(i), Turbine, INPUT_CURR, INPUT_TEMP, MESH_NEWCOPY, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + ! Copy TC solver states from current to predicted + call Glue_CopyTC_State(m%StateCurr, m%StatePred, MESH_NEWCOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + TotalIter = 0 + + ! Set converged flag to false + IsConverged = .false. + + ! Allocate input-output solve Jacobian matrix and RHS vector + call AllocAry(Jac, m%Mod%Vars%Nu, m%Mod%Vars%Nu, 'Jac', ErrStat2, ErrMsg2) + if (Failed()) return + call AllocAry(XB, m%Mod%Vars%Nu, 1, 'XB', ErrStat2, ErrMsg2) + if (Failed()) return + + !---------------------------------------------------------------------------- + ! Input solve and calc output for ServoDyn inputs + !---------------------------------------------------------------------------- + + do i = 1, size(p%iModInit) + associate (ModData => GlueModData(p%iModInit(i))) + + ! Solve for inputs + call FAST_InputSolve(p%iModInit(i), GlueModData, GlueModMaps, INPUT_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Calculate outputs + call FAST_CalcOutput(ModData, GlueModMaps, t_initial, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + end associate + end do + + !---------------------------------------------------------------------------- + ! InputSolve and CalcOutput for Option 2 modules + !---------------------------------------------------------------------------- + + ! Do input solve and calculate outputs for Option 2 modules (includes TC modules) + do i = 1, size(p%iModOpt2) + + ! Solve for inputs + call FAST_InputSolve(p%iModOpt2(i), GlueModData, GlueModMaps, INPUT_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Calculate outputs + call FAST_CalcOutput(GlueModData(p%iModOpt2(i)), GlueModMaps, t_initial, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + end do + + !---------------------------------------------------------------------------- + ! InputSolve and pack inputs for TC and Option 1 modules + !---------------------------------------------------------------------------- + + ! Do input solve for Option 1 modules + do i = 1, size(p%iModOpt1) + call FAST_InputSolve(p%iModOpt1(i), GlueModData, GlueModMaps, INPUT_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + ! Pack TC and Option 1 inputs into u array + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_GetOP(ModData, t_initial, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + u_op=ModData%Lin%u, u_glue=m%Mod%Lin%u) + if (Failed()) return + end associate + end do + + !---------------------------------------------------------------------------- + ! Convergence Iterations for TC and Option 1 modules + !---------------------------------------------------------------------------- + + ! Loop through convergence iterations + do ConvIter = 0, p%MaxConvIter + + ! Increment total number of convergence iterations in step + TotalIter = TotalIter + 1 + + !------------------------------------------------------------------------- + ! Calculate outputs for TC & Opt1 modules + !------------------------------------------------------------------------- + + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_CalcOutput(ModData, GlueModMaps, t_initial, INPUT_CURR, STATE_CURR, & + Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end associate + end do + + !------------------------------------------------------------------------- + ! Convergence iteration and input check + !------------------------------------------------------------------------- + + ! If convergence iteration limit has been reached or there are no inputs + ! involved in module mappings, exit loop + if ((ConvIter >= p%MaxConvIter) .or. (m%Mod%Vars%Nu == 0)) exit + + !------------------------------------------------------------------------- + ! Update Jacobian + !------------------------------------------------------------------------- + + ! Only calculate the Jacobian on the first convergence iteration, as + ! it should remain the same through subsequent iterations + if (ConvIter == 0) then + + !---------------------------------------------------------------------- + ! Calculate Input-Output Solve Jacobian for TC and Option 1 modules + !---------------------------------------------------------------------- + + m%Mod%Lin%dYdu = 0.0_R8Ki + m%Mod%Lin%dUdy = 0.0_R8Ki + + call Eye2D(m%Mod%Lin%dUdu, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Loop through TC and Option 1 modules and calculate dYdu + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_JacobianPInput(ModData, t_initial, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + dYdu=ModData%Lin%dYdu, dYdu_glue=m%Mod%Lin%dYdu) + if (Failed()) return + end associate + end do + + ! Calculate dUdu and dUdy for TC and Option 1 modules + call FAST_LinearizeMappings(m%Mod, GlueModMaps, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + !---------------------------------------------------------------------- + ! Assemble Jacobian + !---------------------------------------------------------------------- + + ! Jac = m%Mod%Lin%dUdu + matmul(m%Mod%Lin%dUdy, m%Mod%Lin%dYdu) + Jac = m%Mod%Lin%dUdu + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, m%Mod%Lin%dUdy, m%Mod%Lin%dYdu, 1.0_R8Ki, Jac, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Condition Jacobian matrix loads before factoring + if (p%iUL(1) > 0) then + Jac(p%iUL(1):p%iUL(2), :) = Jac(p%iUL(1):p%iUL(2), :)/p%Scale_UJac + Jac(:, p%iUL(1):p%iUL(2)) = Jac(:, p%iUL(1):p%iUL(2))*p%Scale_UJac + end if + + ! Factor jacobian matrix + call LAPACK_getrf(size(Jac, 1), size(Jac, 2), Jac, m%IPIV, ErrStat2, ErrMsg2) + if (Failed()) return + end if + + !------------------------------------------------------------------------- + ! Formulate right hand side (U^tight, U^Option1) + !------------------------------------------------------------------------- + + ! Input solve for tight coupling modules + do i = 1, size(p%iModTC) + call FAST_InputSolve(p%iModTC(i), GlueModData, GlueModMaps, INPUT_TEMP, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + ! Input solve for Option 1 modules + do i = 1, size(p%iModOpt1) + call FAST_InputSolve(p%iModOpt1(i), GlueModData, GlueModMaps, INPUT_TEMP, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + ! Collect TC and Option 1 inputs into uCalc + do i = 1, size(m%Mod%ModData) + call FAST_GetOP(m%Mod%ModData(i), t_initial, INPUT_TEMP, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + u_op=m%Mod%ModData(i)%Lin%u, u_glue=m%uCalc) + if (Failed()) return + end do + + !------------------------------------------------------------------------- + ! Populate residual vector and apply conditioning to loads + !------------------------------------------------------------------------- + + ! Calculate difference in U for all Option 1 modules (un - u_tmp) + ! and add to RHS for TC and Option 1 modules + call MV_ComputeDiff(m%Mod%Vars%u, m%uCalc, m%Mod%Lin%u, XB(:, 1)) + + ! Apply conditioning factor to loads in RHS + if (p%iUL(1) > 0) XB(p%iUL(1):p%iUL(2), 1) = XB(p%iUL(1):p%iUL(2), 1)/p%Scale_UJac + + !------------------------------------------------------------------------- + ! Solve for input perturbations + !------------------------------------------------------------------------- + + ! Solve Jacobian and RHS + call LAPACK_getrs('N', size(Jac, 1), Jac, m%IPIV, XB, ErrStat2, ErrMsg2) + if (Failed()) return + + !------------------------------------------------------------------------- + ! Check perturbations for convergence and exit if below tolerance + !------------------------------------------------------------------------- + + ! Calculate average L2 norm of change in states and inputs + ConvError = TwoNorm(XB(:, 1))/size(XB) + + ! If at least one convergence iteration has been done and the RHS norm + ! is less than convergence tolerance, set flag and exit convergence loop + if (ConvError < p%ConvTol) then + IsConverged = .true. + exit + end if + + ! Remove load conditioning on inputs + if (p%iUL(1) > 0) XB(p%iUL(1):p%iUL(2), 1) = XB(p%iUL(1):p%iUL(2), 1)*p%Scale_UJac + + !------------------------------------------------------------------------- + ! Update inputs + !------------------------------------------------------------------------- + + ! Add change in inputs + call MV_AddDelta(m%Mod%Vars%u, XB(:, 1), m%Mod%Lin%u) + + ! Transfer updated inputs to modules + do i = 1, size(m%Mod%ModData) + call FAST_SetOP(m%Mod%ModData(i), INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2, & + u_op=m%Mod%ModData(i)%Lin%u, u_glue=m%Mod%Lin%u) + if (Failed()) return + end do + end do ! Convergence loop + + ! Perform input solve for modules post Option 1 convergence + do i = 1, size(p%iModPost) + call FAST_InputSolve(p%iModPost(i), GlueModData, GlueModMaps, INPUT_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + ! Print warning if not converged + if (.not. IsConverged) then + call WrScr("Solver: initial step not converged, error="// & + trim(Num2LStr(ConvError))//", tol="//trim(Num2LStr(p%ConvTol))) + end if + + !---------------------------------------------------------------------------- + ! Post convergence calculations + !---------------------------------------------------------------------------- + + ! Set algorithmic acceleration from actual acceleration + m%StatePred%a = m%StatePred%vd + + !---------------------------------------------------------------------------- + ! Set Outputs + !---------------------------------------------------------------------------- + + Turbine%y_FAST%DriverWriteOutput(1) = real(TotalIter, ReKi) ! ConvIter + Turbine%y_FAST%DriverWriteOutput(2) = real(ConvError, ReKi) ! ConvError + Turbine%y_FAST%DriverWriteOutput(3) = real(TotalIter, ReKi) ! NumUJac + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine FAST_SolverStep(n_t_global, t_initial, p, m, GlueModData, GlueModMaps, Turbine, ErrStat, ErrMsg) + integer(IntKi), intent(in) :: n_t_global !< global time step + real(DbKi), intent(in) :: t_initial !< Initial simulation time + type(Glue_TCParam), intent(in) :: p !< Parameters + type(Glue_TCMisc), intent(inout) :: m !< Misc variables + type(ModDataType), intent(inout) :: GlueModData(:) !< Glue module data + type(MappingType), intent(inout) :: GlueModMaps(:) !< Module mappings + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'Solver_Step' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + logical, parameter :: IsSolve = .true. + integer(IntKi) :: ConvIter, CorrIter, TotalIter + integer(IntKi) :: NumUJac, NumCorrections + real(R8Ki) :: ConvError + 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) :: i, j, k + integer(IntKi) :: iMod + logical :: ConvUJac ! Jacobian updated for convergence + real(R8Ki) :: RotDiff(3, 3) + + ErrStat = ErrID_None + ErrMsg = '' + + !---------------------------------------------------------------------------- + ! Miscellaneous step updates + !---------------------------------------------------------------------------- + + ! Calculate the next global time step number and time + n_t_global_next = n_t_global + 1 + t_global_next = t_initial + n_t_global_next*p%h + + ! Decrement number of time steps before updating the Jacobian + m%UJacStepsRemain = m%UJacStepsRemain - 1 + + ! Set Jacobian updated for convergence flag to false + ConvUJac = .false. + + ! Init counters for number of Jacobian updates and number of convergence iterations + NumUJac = 0 + TotalIter = 0 + + !---------------------------------------------------------------------------- + ! Correction Iterations + !---------------------------------------------------------------------------- + + ! Loop through correction iterations + CorrIter = 0 + NumCorrections = p%NumCrctn + do while (CorrIter <= NumCorrections) + + ! Reset mapping ready flags + call FAST_ResetMappingReady(GlueModMaps) + + ! Copy TC solver states from current to predicted + call Glue_CopyTC_State(m%StateCurr, m%StatePred, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Perform additional state manipulation on a per-module basis + do i = 1, size(p%iModTC) + associate (ModData => m%Mod%ModData(i)) + + ! Copy state from current to predicted + call FAST_CopyStates(ModData, Turbine, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Additional state manipulation per module + select case (ModData%ID) + case (Module_ED) + + ! Update the azimuth angle + call ED_UpdateAzimuth(Turbine%ED%p(ModData%Ins), Turbine%ED%x(ModData%Ins, STATE_PRED), ModData%DT) + + case (Module_BD) + + ! Transfer acceleration from TC state to BeamDyn + call SetBDAccel(ModData, m%StatePred, Turbine%BD%OtherSt(ModData%Ins, STATE_PRED)) + + ! Reset BeamDyn states so they are relative to the root node + call BD_UpdateGlobalRef(Turbine%BD%Input(INPUT_CURR, ModData%Ins), & + Turbine%BD%p(ModData%Ins), & + Turbine%BD%x(ModData%Ins, STATE_PRED), & + Turbine%BD%OtherSt(ModData%Ins, STATE_PRED), & + ErrStat2, ErrMsg2) + if (Failed()) return + + ! Transfer acceleration from BeamDyn to state + call GetBDAccel(ModData, Turbine%BD%OtherSt(ModData%Ins, STATE_PRED), m%StatePred) + + case default + cycle + end select + + ! Collect updated states + call FAST_GetOP(ModData, t_global_next, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + x_op=ModData%Lin%x, x_glue=m%Mod%Lin%x) + if (Failed()) return + + ! Transfer current states to linearization array + call TransferXtoQ(ModData, m%Mod%Lin%x, m%StatePred) + end associate + end do + + ! Update state prediction + call PredictNextState(p, m%StatePred, m%Mod%Vars) + + ! Loop through tight coupling modules + do i = 1, size(p%iModTC) + associate (ModData => m%Mod%ModData(i)) + + ! Transfer current states to linearization array + call TransferQtoX(ModData, m%StatePred, m%Mod%Lin%x) + + ! Transfer solver states to module + call FAST_SetOP(ModData, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + x_op=ModData%Lin%x, x_glue=m%Mod%Lin%x) + if (Failed()) return + + ! Transfer accelerations to BeamDyn + if (ModData%ID == Module_BD) then + call SetBDAccel(ModData, m%StatePred, Turbine%BD%OtherSt(ModData%Ins, STATE_CURR)) + end if + end associate + end do + + !------------------------------------------------------------------------- + ! Option 2 Solve + !------------------------------------------------------------------------- + + ! Loop through Option 2 modules + do i = 1, size(p%iModOpt2) + associate (ModData => GlueModData(p%iModOpt2(i))) + + ! Solve for inputs + call FAST_InputSolve(p%iModOpt2(i), GlueModData, GlueModMaps, INPUT_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Update states + call FAST_UpdateStates(ModData, t_initial, n_t_global, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Calculate outputs + call FAST_CalcOutput(ModData, GlueModMaps, t_global_next, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end associate + end do + + !------------------------------------------------------------------------- + ! Option 1 Solve + !------------------------------------------------------------------------- + + ! Get inputs and update states for Option 1 modules + do i = 1, size(p%iModOpt1) + call FAST_InputSolve(p%iModOpt1(i), GlueModData, GlueModMaps, INPUT_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + call FAST_UpdateStates(GlueModData(p%iModOpt1(i)), t_initial, n_t_global, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + !------------------------------------------------------------------------- + ! Pack inputs and modify states + !------------------------------------------------------------------------- + + ! Pack TC and Option 1 inputs into u array + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_GetOP(ModData, t_global_next, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + u_op=ModData%Lin%u, u_glue=m%Mod%Lin%u) + if (Failed()) return + end associate + end do + + !------------------------------------------------------------------------- + ! Convergence Iterations + !------------------------------------------------------------------------- + + ! Loop through convergence iterations + do ConvIter = 0, p%MaxConvIter + + ! Increment total number of convergence iterations in step + TotalIter = TotalIter + 1 + + ! Decrement number of iterations before updating the Jacobian + m%UJacIterRemain = m%UJacIterRemain - 1 + + !---------------------------------------------------------------------- + ! Calculate outputs for TC & Opt1 modules + !---------------------------------------------------------------------- + + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_CalcOutput(ModData, GlueModMaps, t_global_next, INPUT_CURR, STATE_PRED, & + Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end associate + end do + + !---------------------------------------------------------------------- + ! Convergence iteration check + !---------------------------------------------------------------------- + + ! If convergence iteration has reached or exceeded limit + if (ConvIter >= p%MaxConvIter) then + + ! If Jacobian has not been updated for convergence + if (.not. ConvUJac) then + + ! Set counter to trigger a Jacobian update on next convergence iteration + m%UJacIterRemain = 0 + + ! If at the maximum number of correction iterations, + ! increase limit to retry the step after the Jacobian is updated + if (CorrIter == NumCorrections) NumCorrections = NumCorrections + 1 + + ! Set flag indicating that the jacobian has been updated for convergence + ConvUJac = .true. + + else + + ! Otherwise, correction iteration with Jacobian update has been tried, + ! display warning that convergence failed and move to next step + call SetErrStat(ErrID_Warn, "Failed to converge in "//trim(Num2LStr(p%MaxConvIter))// & + " iterations on step "//trim(Num2LStr(n_t_global_next))// & + " (error="//trim(Num2LStr(ConvError))// & + ", tolerance="//trim(Num2LStr(p%ConvTol))//"). "// & + "Solution will continue but may be invalid.", & + ErrStat, ErrMsg, RoutineName) + end if + + ! Exit convergence loop to next correction iteration or next step + exit + end if + + !---------------------------------------------------------------------- + ! Update Jacobian + !---------------------------------------------------------------------- + + ! If number of iterations or steps until Jacobian is to be updated + ! is zero or less, or first solution step, then rebuild the Jacobian. + ! Note: BuildJacobian resets these counters. + if ((m%UJacIterRemain <= 0) .or. (m%UJacStepsRemain <= 0)) then + NumUJac = NumUJac + 1 + call BuildJacobianTC(p, m, GlueModMaps, t_global_next, STATE_PRED, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end if + + !---------------------------------------------------------------------- + ! Formulate right hand side (X_2^tight, U^tight, U^Option1) + !---------------------------------------------------------------------- + + ! Calculate continuous state derivatives for tight coupling modules + do i = 1, size(m%Mod%ModData) + call FAST_GetOP(m%Mod%ModData(i), t_global_next, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + dx_op=m%Mod%ModData(i)%Lin%dx, dx_glue=m%Mod%Lin%dx) + if (Failed()) return + end do + + ! Input solve for tight coupling modules + do i = 1, size(p%iModTC) + associate (ModData => GlueModData(p%iModTC(i))) + call FAST_InputSolve(p%iModTC(i), GlueModData, GlueModMaps, INPUT_TEMP, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end associate + end do + + ! Input solve for Option 1 modules + do i = 1, size(p%iModOpt1) + associate (ModData => GlueModData(p%iModOpt1(i))) + call FAST_InputSolve(p%iModOpt1(i), GlueModData, GlueModMaps, INPUT_TEMP, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end associate + end do + + ! Transfer collect inputs into uCalc + do i = 1, size(m%Mod%ModData) + call FAST_GetOP(m%Mod%ModData(i), t_global_next, INPUT_TEMP, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + u_op=m%Mod%ModData(i)%Lin%u, u_glue=m%uCalc) + if (Failed()) return + end do + + !---------------------------------------------------------------------- + ! Populate residual vector and apply conditioning to loads + !---------------------------------------------------------------------- + + ! Calculate difference between calculated and predicted accelerations + if (p%iJX(1) > 0) m%XB(p%iJX(1):p%iJX(2), 1) = m%Mod%Lin%dx(p%iX2(1):p%iX2(2)) - m%StatePred%vd + + ! Calculate difference in U for all Option 1 modules (un - u_tmp) + ! and add to RHS for TC and Option 1 modules + if (p%iJU(1) > 0) call MV_ComputeDiff(m%Mod%Vars%u, m%uCalc, m%Mod%Lin%u, m%XB(p%iJU(1):p%iJU(2), 1)) + + ! Apply conditioning factor to loads in RHS + if (p%iJL(1) > 0) m%XB(p%iJL(1):p%iJL(2), 1) = m%XB(p%iJL(1):p%iJL(2), 1)/p%Scale_UJac + + !---------------------------------------------------------------------- + ! Solve for state and input perturbations + !---------------------------------------------------------------------- + + ! Solve Jacobian and RHS + call LAPACK_getrs('N', p%NumJ, m%Mod%Lin%J, m%IPIV, m%XB, ErrStat2, ErrMsg2) + if (Failed()) return + + !---------------------------------------------------------------------- + ! Check perturbations for convergence and exit if below tolerance + !---------------------------------------------------------------------- + + ! Calculate average L2 norm of change in states and inputs + ConvError = TwoNorm(m%XB(:, 1))/size(m%XB) + + ! Write step debug info if requested + if (DebugSolver) call Solver_Step_Debug(p, m, n_t_global_next, CorrIter, ConvIter, ConvError) + + ! If at least one convergence iteration has been done and + ! the RHS norm is less than convergence tolerance, exit loop + if ((ConvIter > 0) .and. (ConvError < p%ConvTol)) exit + + ! Remove load condition conditioning on input changes + if (p%iJL(1) > 0) m%XB(p%iJL(1):p%iJL(2), 1) = m%XB(p%iJL(1):p%iJL(2), 1)*p%Scale_UJac + + !---------------------------------------------------------------------- + ! Update State for Tight Coupling modules + !---------------------------------------------------------------------- + + if (p%iJX(1) > 0) call UpdateStatePrediction(p, m%Mod%Vars, m%XB(p%iJX(1):p%iJX(2), 1), m%StatePred) + + !---------------------------------------------------------------------- + ! Update inputs for Tight Coupling and Option 1 modules + !---------------------------------------------------------------------- + + ! Add change in inputs + if (p%iJU(1) > 0) call MV_AddDelta(m%Mod%Vars%u, m%XB(p%iJU(1):p%iJU(2), 1), m%Mod%Lin%u) + + !---------------------------------------------------------------------- + ! Transfer updated TC and Option 1 states and inputs to modules + !---------------------------------------------------------------------- + + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + + ! Transfer States to linearization array + call TransferQtoX(ModData, m%StatePred, m%Mod%Lin%x) + + ! Transfer states and inputs to modules + call FAST_SetOP(ModData, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + x_op=ModData%Lin%x, x_glue=m%Mod%Lin%x, & + u_op=ModData%Lin%u, u_glue=m%Mod%Lin%u) + if (Failed()) return + + ! Transfer accelerations to BeamDyn + if (ModData%ID == Module_BD) then + call SetBDAccel(ModData, m%StatePred, Turbine%BD%OtherSt(ModData%Ins, STATE_PRED)) + end if + + end associate + end do + end do + + ! Increment correction iteration counter + CorrIter = CorrIter + 1 + + ! Perform input solve for modules post Option 1 convergence + do i = 1, size(p%iModPost) + call FAST_InputSolve(p%iModPost(i), GlueModData, GlueModMaps, INPUT_CURR, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + ! Reset mesh remap + call FAST_ResetRemapFlags(GlueModData, GlueModMaps, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + !---------------------------------------------------------------------------- + ! Set Outputs + !---------------------------------------------------------------------------- + + Turbine%y_FAST%DriverWriteOutput(1) = real(TotalIter, ReKi) ! ConvIter + Turbine%y_FAST%DriverWriteOutput(2) = real(ConvError, ReKi) ! ConvError + Turbine%y_FAST%DriverWriteOutput(3) = real(NumUJac, ReKi) ! NumUJac + +contains + logical function Failed() + if (ErrStat2 /= ErrID_None) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine CalcOutputs_And_SolveForInputs(p, m, GlueModData, GlueModMaps, ThisTime, iInput, iState, Turbine, ErrStat, ErrMsg, DoInit) + type(Glue_TCParam), intent(in) :: p !< Parameters + type(Glue_TCMisc), intent(inout) :: m !< Misc variables + type(ModDataType), intent(inout) :: GlueModData(:) !< Module data + type(MappingType), intent(inout) :: GlueModMaps(:) !< Module mappings at glue level + real(DbKi), intent(in) :: ThisTime !< Time + integer(IntKi), intent(in) :: iInput !< Input index + integer(IntKi), intent(in) :: iState !< State index + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + logical, optional :: DoInit + + character(*), parameter :: RoutineName = 'CalcOutputs_And_SolveForInputs' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: ConvIter + real(R8Ki) :: ConvError + integer(IntKi) :: i + + !---------------------------------------------------------------------------- + ! Special Initialization + !---------------------------------------------------------------------------- + + if (present(DoInit)) then + if (DoInit) then + + ! Input solve and calc output for ServoDyn inputs + do i = 1, size(p%iModInit) + associate (ModData => GlueModData(p%iModInit(i))) + + ! Solve for inputs + call FAST_InputSolve(p%iModInit(i), GlueModData, GlueModMaps, iInput, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Calculate outputs + call FAST_CalcOutput(ModData, GlueModMaps, ThisTime, iInput, iState, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + end associate + end do + end if + end if + + !---------------------------------------------------------------------------- + ! Option 2 Solve + !---------------------------------------------------------------------------- + + ! Do input solve and calculate outputs for Option 2 modules (except ServoDyn) + do i = 2, size(p%iModOpt2) + associate (ModData => GlueModData(p%iModOpt2(i))) + + ! Solve for inputs + call FAST_InputSolve(p%iModOpt2(i), GlueModData, GlueModMaps, iInput, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Calculate outputs + call FAST_CalcOutput(ModData, GlueModMaps, ThisTime, iInput, iState, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + end associate + end do + + !---------------------------------------------------------------------------- + ! Option 1 Solve + !---------------------------------------------------------------------------- + + ! Get inputs for Option 1 modules + do i = 1, size(p%iModOpt1) + call FAST_InputSolve(p%iModOpt1(i), GlueModData, GlueModMaps, iInput, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + !---------------------------------------------------------------------------- + ! Pack inputs + !---------------------------------------------------------------------------- + + ! Pack TC and Option 1 inputs into u array + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_GetOP(ModData, ThisTime, iInput, iState, Turbine, ErrStat2, ErrMsg2, & + u_op=ModData%Lin%u, u_glue=m%Mod%Lin%u) + if (Failed()) return + end associate + end do + + !---------------------------------------------------------------------------- + ! Option 1 Convergence Iterations + !---------------------------------------------------------------------------- + + ! Loop through convergence iterations + do ConvIter = 0, p%MaxConvIter + + ! Calculate outputs for TC & Option 1 modules + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_CalcOutput(ModData, GlueModMaps, ThisTime, iInput, iState, & + Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end associate + end do + + !------------------------------------------------------------------------- + ! Convergence iteration limit check + !------------------------------------------------------------------------- + + ! If convergence iteration has reached or exceeded limit, exit loop + if (ConvIter >= p%MaxConvIter) then + call SetErrStat(ErrID_Warn, "Failed to converge in "//trim(Num2LStr(p%MaxConvIter))// & + " iterations (error="//trim(Num2LStr(ConvError))// & + ", tolerance="//trim(Num2LStr(p%ConvTol))//").", & + ErrStat, ErrMsg, RoutineName) + exit + end if + + !------------------------------------------------------------------------- + ! Update Jacobian + !------------------------------------------------------------------------- + + call BuildJacobianIO(p, m, GlueModMaps, ThisTime, iState, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + + !---------------------------------------------------------------------- + ! Formulate right hand side (U) + !---------------------------------------------------------------------- + + ! Input solve for tight coupling modules + do i = 1, size(p%iModTC) + associate (ModData => GlueModData(p%iModTC(i))) + call FAST_InputSolve(p%iModTC(i), GlueModData, GlueModMaps, INPUT_TEMP, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end associate + end do + + ! Input solve for Option 1 modules + do i = 1, size(p%iModOpt1) + associate (ModData => GlueModData(p%iModOpt1(i))) + call FAST_InputSolve(p%iModOpt1(i), GlueModData, GlueModMaps, INPUT_TEMP, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end associate + end do + + ! Transfer collect inputs into uCalc + do i = 1, size(m%Mod%ModData) + call FAST_GetOP(m%Mod%ModData(i), ThisTime, INPUT_TEMP, iState, Turbine, ErrStat2, ErrMsg2, & + u_op=m%Mod%ModData(i)%Lin%u, u_glue=m%uCalc) + if (Failed()) return + end do + + !------------------------------------------------------------------------- + ! Populate residual vector and apply conditioning to loads + !------------------------------------------------------------------------- + + ! Calculate difference in U for all Option 1 modules (un - u_tmp) + ! and add to RHS for TC and Option 1 modules + if (p%iJU(1) > 0) call MV_ComputeDiff(m%Mod%Vars%u, m%uCalc, m%Mod%Lin%u, m%XB_IO(:, 1)) + + ! Apply conditioning factor to loads in RHS + if (p%iUL(1) > 0) m%XB_IO(p%iUL(1):p%iUL(2), 1) = m%XB_IO(p%iUL(1):p%iUL(2), 1)/p%Scale_UJac + + !------------------------------------------------------------------------- + ! Solve for state and input perturbations + !------------------------------------------------------------------------- + + ! Solve Jacobian and RHS + call LAPACK_getrs('N', size(m%Jac_IO, 1), m%Jac_IO, m%IPIV, m%XB_IO, ErrStat2, ErrMsg2) + if (Failed()) return + + !------------------------------------------------------------------------- + ! Check perturbations for convergence and exit if below tolerance + !------------------------------------------------------------------------- + + ! Calculate average L2 norm of change in states and inputs + ConvError = TwoNorm(m%XB_IO(:, 1))/size(m%XB_IO) + + ! If at least one convergence iteration has been done and + ! the RHS norm is less than convergence tolerance, exit loop + if ((ConvIter > 0) .and. (ConvError < p%ConvTol)) exit + + ! Remove load condition conditioning on input changes + if (p%iUL(1) > 0) m%XB_IO(p%iUL(1):p%iUL(2), 1) = m%XB_IO(p%iUL(1):p%iUL(2), 1)*p%Scale_UJac + + !------------------------------------------------------------------------- + ! Update inputs for Tight Coupling and Option 1 modules + !------------------------------------------------------------------------- + + ! Add change in inputs + if (p%iJU(1) > 0) call MV_AddDelta(m%Mod%Vars%u, m%XB_IO(:, 1), m%Mod%Lin%u) + + ! Transfer updated TC and Option 1 inputs to modules + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_SetOP(ModData, iInput, iState, Turbine, ErrStat2, ErrMsg2, & + u_op=ModData%Lin%u, u_glue=m%Mod%Lin%u) + if (Failed()) return + end associate + end do + end do + + !---------------------------------------------------------------------------- + ! Post Option 1 solve + !---------------------------------------------------------------------------- + + ! Perform input solve for modules post Option 1 convergence + do i = 1, size(p%iModPost) + call FAST_InputSolve(p%iModPost(i), GlueModData, GlueModMaps, iInput, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + ! Reset mesh remap + call FAST_ResetRemapFlags(GlueModData, GlueModMaps, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + +contains + logical function Failed() + if (ErrStat2 /= ErrID_None) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +! Build Jacobian for tight coupling solve +subroutine BuildJacobianTC(p, m, GlueModMaps, ThisTime, iState, Turbine, ErrStat, ErrMsg) + type(Glue_TCParam), intent(in) :: p !< Parameters + type(Glue_TCMisc), intent(inout) :: m !< Misc variables + type(MappingType), intent(inout) :: GlueModMaps(:) !< Module mappings at glue level + real(DbKi), intent(in) :: ThisTime !< Time + integer(IntKi), intent(in) :: iState !< State index + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'BuildJacobianTC' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + real(R8Ki), allocatable :: J22(:, :) + integer(IntKi) :: i, j, k, idx + + ErrStat = ErrID_None + ErrMsg = '' + + ! Reset Jacobian update countdown values + m%UJacIterRemain = p%NIter_UJac + m%UJacStepsRemain = p%NStep_UJac + + if (size(m%Mod%Lin%J) == 0) return + + !---------------------------------------------------------------------------- + ! Get module Jacobians and assemble + ! A: rows = x; columns = x (dXdx) + ! B: rows = x; columns = u (dXdu) + ! C: rows = y; columns = x (dYdx) + ! D: rows = y; columns = u (dYdu) + !---------------------------------------------------------------------------- + + ! Initialize Jacobian matrices + if (allocated(m%Mod%Lin%dYdx)) m%Mod%Lin%dYdx = 0.0_R8Ki + if (allocated(m%Mod%Lin%dXdx)) m%Mod%Lin%dXdx = 0.0_R8Ki + if (allocated(m%Mod%Lin%dXdu)) m%Mod%Lin%dXdu = 0.0_R8Ki + if (allocated(m%Mod%Lin%dYdu)) m%Mod%Lin%dYdu = 0.0_R8Ki + if (allocated(m%Mod%Lin%dUdy)) m%Mod%Lin%dUdy = 0.0_R8Ki + if (allocated(m%Mod%Lin%dUdu)) then + call Eye2D(m%Mod%Lin%dUdu, ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! Loop through modules tight coupling modules + do i = 1, size(p%iModTC) + associate (ModData => m%Mod%ModData(i)) + + ! Calculate dYdx, dXdx for tight coupling modules + call FAST_JacobianPContState(ModData, ThisTime, INPUT_CURR, iState, Turbine, ErrStat2, ErrMsg2, & + dXdx=ModData%Lin%dXdx, dXdx_glue=m%Mod%Lin%dXdx, & + dYdx=ModData%Lin%dYdx, dYdx_glue=m%Mod%Lin%dYdx) + if (Failed()) return + + ! Calculate Jacobians wrt inputs + call FAST_JacobianPInput(ModData, ThisTime, INPUT_CURR, iState, Turbine, ErrStat2, ErrMsg2, & + dXdu=ModData%Lin%dXdu, dXdu_glue=m%Mod%Lin%dXdu, & + dYdu=ModData%Lin%dYdu, dYdu_glue=m%Mod%Lin%dYdu) + if (Failed()) return + end associate + end do + + ! Loop through Option 1 modules and calculate dYdu + do i = size(p%iModTC) + 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_JacobianPInput(ModData, ThisTime, INPUT_CURR, iState, Turbine, ErrStat2, ErrMsg2, & + dYdu=ModData%Lin%dYdu, dYdu_glue=m%Mod%Lin%dYdu) + if (Failed()) return + end associate + end do + + ! Calculate dUdu and dUdy for TC and Option 1 modules + if (allocated(m%Mod%Lin%dUdy) .and. allocated(m%Mod%Lin%dUdu)) then + call FAST_LinearizeMappings(m%Mod, GlueModMaps, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end if + + !---------------------------------------------------------------------------- + ! Assemble Jacobian + !---------------------------------------------------------------------------- + + ! If states in Jacobian + if (p%iJX(1) > 0) then + + ! Group (1,1) + associate (dX2dx2 => m%Mod%Lin%dXdx(p%iX2(1):p%iX2(2), p%iX2(1):p%iX2(2)), & + dX2dx1 => m%Mod%Lin%dXdx(p%iX2(1):p%iX2(2), p%iX1(1):p%iX1(2))) + m%J11 = -p%GammaPrime*dX2dx2 - p%BetaPrime*dX2dx1 + do i = p%iJX(1), p%iJX(2) + m%J11(i, i) = m%J11(i, i) + 1.0_R8Ki + end do + m%Mod%Lin%J(p%iJX(1):p%iJX(2), p%iJX(1):p%iJX(2)) = m%J11 + end associate + + ! Group (2,1) + if (p%iyT(1) > 0 .and. p%iUT(1) > 0) then + associate (dUTdyT => m%Mod%Lin%dUdy(p%iUT(1):p%iUT(2), p%iyT(1):p%iyT(2)), & + dYTdx2 => m%Mod%Lin%dYdx(p%iyT(1):p%iyT(2), p%iX2(1):p%iX2(2)), & + dYTdx1 => m%Mod%Lin%dYdx(p%iyT(1):p%iyT(2), p%iX1(1):p%iX1(2))) + m%Mod%Lin%J(p%iJUT(1):p%iJUT(2), p%iJX(1):p%iJX(2)) = & + p%GammaPrime*matmul(dUTdyT, dYTdx2) + p%BetaPrime*matmul(dUTdyT, dYTdx1) + end associate + end if + + ! Group (1,2) + if (p%iUT(1) > 0) then + associate (J12 => m%Mod%Lin%J(p%iJX(1):p%iJX(2), p%iJUT(1):p%iJUT(2)), & + dX2duT => m%Mod%Lin%dXdu(p%iX2(1):p%iX2(2), p%iUT(1):p%iUT(2))) + J12 = -dX2duT + end associate + end if + + end if + + ! Group (2,2) - Inputs = dUdu + matmul(dUdy, dYdu) + if (p%iJU(1) > 0) then + J22 = m%Mod%Lin%dUdu + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, m%Mod%Lin%dUdy, m%Mod%Lin%dYdu, 1.0_R8Ki, J22, ErrStat2, ErrMsg2); if (Failed()) return + m%Mod%Lin%J(p%iJU(1):p%iJU(2), p%iJU(1):p%iJU(2)) = J22 + end if + + ! Write debug matrices if requested + if (DebugJacobian) then + + ! Get module outputs + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_GetOP(ModData, ThisTime, INPUT_CURR, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + y_op=ModData%Lin%y, y_glue=m%Mod%Lin%y) + if (Failed()) return + end associate + end do + + ! Write debug info + call BuildJacobian_Debug(m, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! Condition jacobian matrix before factoring + if (p%iJL(1) > 0) then + m%Mod%Lin%J(p%iJL(1):p%iJL(2), :) = m%Mod%Lin%J(p%iJL(1):p%iJL(2), :)/p%Scale_UJac + m%Mod%Lin%J(:, p%iJL(1):p%iJL(2)) = m%Mod%Lin%J(:, p%iJL(1):p%iJL(2))*p%Scale_UJac + end if + + ! Factor jacobian matrix + call LAPACK_getrf(size(m%Mod%Lin%J, 1), size(m%Mod%Lin%J, 2), m%Mod%Lin%J, m%IPIV, ErrStat2, ErrMsg2) + if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +! Build Jacobian for Input-Output solve (CalcOutputs_And_SolveForInputs) +subroutine BuildJacobianIO(p, m, GlueModMaps, ThisTime, iState, Turbine, ErrStat, ErrMsg) + type(Glue_TCParam), intent(in) :: p !< Parameters + type(Glue_TCMisc), intent(inout) :: m !< Misc variables + type(MappingType), intent(inout) :: GlueModMaps(:) !< Module mappings at glue level + real(DbKi), intent(in) :: ThisTime !< Time + integer(IntKi), intent(in) :: iState !< State index + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'BuildJacobian' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + real(R8Ki) :: phi, rv(3), T(3, 3), tmp1, tmp2, T2(3, 3) + integer(IntKi) :: i, j, k, idx + + ErrStat = ErrID_None + ErrMsg = '' + + if (.not. allocated(m%Jac_IO)) then + call AllocAry(m%Jac_IO, m%Mod%Vars%Nu, m%Mod%Vars%Nu, 'm%Jac_IO', ErrStat2, ErrMsg2) + if (Failed()) return + end if + + if (.not. allocated(m%XB_IO)) then + call AllocAry(m%XB_IO, m%Mod%Vars%Nu, 1, 'm%XB_IO', ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! Loop through TC and Option 1 modules and calculate dYdu + if (allocated(m%Mod%Lin%dYdu)) m%Mod%Lin%dYdu = 0.0_R8Ki + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call FAST_JacobianPInput(ModData, ThisTime, INPUT_CURR, iState, Turbine, ErrStat2, ErrMsg2, & + dYdu=ModData%Lin%dYdu, dYdu_glue=m%Mod%Lin%dYdu) + if (Failed()) return + end associate + end do + + ! Calculate dUdu and dUdy for TC and Option 1 modules + if (allocated(m%Mod%Lin%dUdy) .and. allocated(m%Mod%Lin%dUdu)) then + m%Mod%Lin%dUdy = 0.0_R8Ki + call Eye2D(m%Mod%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_LinearizeMappings(m%Mod, GlueModMaps, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + end if + + !---------------------------------------------------------------------------- + ! Assemble Jacobian + !---------------------------------------------------------------------------- + + ! Jac = m%Mod%Lin%dUdu + matmul(m%Mod%Lin%dUdy, m%Mod%Lin%dYdu) + if (m%Mod%Vars%Nu > 0) then + m%Jac_IO = m%Mod%Lin%dUdu + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, m%Mod%Lin%dUdy, m%Mod%Lin%dYdu, 1.0_R8Ki, m%Jac_IO, ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! Condition Jacobian matrix before factoring + if (p%iUL(1) > 0) then + m%Jac_IO(p%iUL(1):p%iUL(2), :) = m%Jac_IO(p%iUL(1):p%iUL(2), :)/p%Scale_UJac + m%Jac_IO(:, p%iUL(1):p%iUL(2)) = m%Jac_IO(:, p%iUL(1):p%iUL(2))*p%Scale_UJac + end if + + ! Factor Jacobian matrix + call LAPACK_getrf(size(m%Jac_IO, 1), size(m%Jac_IO, 2), m%Jac_IO, m%IPIV, ErrStat2, ErrMsg2) + if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +!------------------------------------------------------------------------------- +! Utility functions +!------------------------------------------------------------------------------- + +pure subroutine PredictNextState(p, State, Vars) + type(Glue_TCParam), intent(in) :: p + type(TC_State), intent(inout) :: State + type(ModVarsType), intent(in) :: Vars + real(R8Ki) :: v_p, vd_p, a_p + integer(IntKi) :: i + + ! Loop through values and calculate acceleration, algo acceleration, velocity, and delta displacement + do i = 1, size(State%q) + + ! Store previous velocity, acceleration, and algorithmic acceleration + v_p = State%v(i) + vd_p = State%vd(i) + a_p = State%a(i) + + ! Set acceleration to zero + State%vd(i) = 0.0_R8Ki + + ! Calculate new algorithmic acceleration + State%a(i) = (p%AlphaF*vd_p - p%AlphaM*a_p)/(1.0_R8Ki - p%AlphaM) + + ! Calculate new velocity + State%v(i) = v_p + p%h*(1.0_R8Ki - p%Gamma)*a_p + p%Gamma*p%h*State%a(i) + + ! Copy current displacement to previous displacement + State%q_prev(i) = State%q(i) + + ! Predict change in displacement + State%x(i) = p%h*v_p + p%h*p%h*(0.5_R8Ki - p%Beta)*a_p + p%Beta*p%h*p%h*State%a(i) + end do + + ! Calculate new displacements from delta + call CalculateStateQ(State, Vars, p%h) +end subroutine + +pure subroutine CalculateStateQ(State, Vars, h) + type(TC_State), intent(inout) :: State + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: h + integer(IntKi) :: i, j, iq + real(R8Ki) :: quat_prev(3), quat_delta(3), quat_new(3) + + ! Calculate new displacement (valid for all states except orientation) + State%q = State%q_prev + State%x + + ! Loop through variables and compose rotations + do i = 1, size(Vars%x) + select case (Vars%x(i)%Field) + case (FieldOrientation) + iq = Vars%x(i)%iq(1) + do j = 1, Vars%x(i)%Nodes + quat_delta = rvec_to_quat(State%x(iq:iq + 2)) + quat_prev = State%q_prev(iq:iq + 2) + quat_new = quat_compose(quat_prev, quat_delta) + State%q(iq:iq + 2) = quat_new + iq = iq + 3 + end do + end select + end do +end subroutine + +pure subroutine UpdateStatePrediction(p, Vars, delta_vd, State) + type(Glue_TCParam), intent(in) :: p + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: delta_vd(:) + type(TC_State), intent(inout) :: State + + ! Update x by delta x + State%x = State%x + p%BetaPrime*delta_vd + + ! Update velocity + State%v = State%v + p%GammaPrime*delta_vd + + ! Update acceleration + State%vd = State%vd + delta_vd + + ! Update algorithmic acceleration + State%a = State%a + (1.0_R8Ki - p%AlphaF)/(1.0_R8Ki - p%AlphaM)*delta_vd + + ! Update displacement calculation + call CalculateStateQ(State, Vars, p%h) + +end subroutine + +pure subroutine TransferXtoQ(ModData, x, State) + type(ModDataType), intent(in) :: ModData + real(R8Ki), intent(in) :: x(:) + type(TC_State), intent(inout) :: State + integer(IntKi) :: i + do i = 1, size(ModData%Vars%x) + associate (Var => ModData%Vars%x(i)) + select case (Var%DerivOrder) + case (0) ! Displacement + State%q(Var%iq(1):Var%iq(2)) = x(Var%iGlu(1):Var%iGlu(2)) + case (1) ! Velocity + State%v(Var%iq(1):Var%iq(2)) = x(Var%iGlu(1):Var%iGlu(2)) + end select + end associate + end do +end subroutine + +pure subroutine TransferQtoX(ModData, State, x) + type(ModDataType), intent(in) :: ModData + type(TC_State), intent(in) :: State + real(R8Ki), intent(inout) :: x(:) + integer(IntKi) :: i + do i = 1, size(ModData%Vars%x) + associate (Var => ModData%Vars%x(i)) + select case (Var%DerivOrder) + case (0) ! Displacement + x(Var%iGlu(1):Var%iGlu(2)) = State%q(Var%iq(1):Var%iq(2)) + case (1) ! Velocity + x(Var%iGlu(1):Var%iGlu(2)) = State%v(Var%iq(1):Var%iq(2)) + end select + end associate + end do +end subroutine + +pure subroutine SetBDAccel(ModData, State, BD_OtherSt) + type(ModDataType), intent(in) :: ModData + type(TC_State), intent(in) :: State + type(BD_OtherStateType), intent(inout) :: BD_OtherSt + integer(IntKi) :: i + do i = 1, size(ModData%Vars%x) + associate (Var => ModData%Vars%x(i)) + select case (Var%Field) + case (FieldTransVel, FieldAngularVel) + BD_OtherSt%acc(Var%iLB:Var%iUB, Var%j) = State%vd(Var%iq(1):Var%iq(2)) + BD_OtherSt%xcc(Var%iLB:Var%iUB, Var%j) = State%a(Var%iq(1):Var%iq(2)) + end select + end associate + end do +end subroutine + +pure subroutine GetBDAccel(ModData, BD_OtherSt, State) + type(ModDataType), intent(in) :: ModData + type(BD_OtherStateType), intent(in) :: BD_OtherSt + type(TC_State), intent(inout) :: State + integer(IntKi) :: i + do i = 1, size(ModData%Vars%x) + associate (Var => ModData%Vars%x(i)) + select case (Var%Field) + case (FieldTransVel, FieldAngularVel) + State%vd(Var%iq(1):Var%iq(2)) = BD_OtherSt%acc(Var%iLB:Var%iUB, Var%j) + State%a(Var%iq(1):Var%iq(2)) = BD_OtherSt%xcc(Var%iLB:Var%iUB, Var%j) + end select + end associate + end do +end subroutine + +!------------------------------------------------------------------------------- +! Debugging routines +!------------------------------------------------------------------------------- + +subroutine Solver_Init_Debug(p, m, GlueModData, GlueModMaps) + type(Glue_TCParam), intent(in) :: p !< Parameters + type(Glue_TCMisc), intent(in) :: m !< Misc variables + type(ModDataType), intent(in) :: GlueModData(:) !< Module data + type(MappingType), intent(in) :: GlueModMaps(:) !< Module mappings at glue level + integer(IntKi) :: i, j + + write (DebugUn, '(A,*(I6))') " p%iJX2 = ", p%iJX + write (DebugUn, '(A,*(I6))') " p%iJUT = ", p%iJUT + write (DebugUn, '(A,*(I6))') " p%iJU = ", p%iJU + write (DebugUn, '(A,*(I6))') " p%iJL = ", p%iJL + write (DebugUn, '(A,*(I6))') " p%iX2 = ", p%iX2 + write (DebugUn, '(A,*(I6))') " p%iX1 = ", p%iX1 + write (DebugUn, '(A,*(I6))') " p%iUT = ", p%iUT + write (DebugUn, '(A,*(I6))') " p%iU1 = ", p%iU1 + write (DebugUn, '(A,*(I6))') " p%iyT = ", p%iyT + write (DebugUn, '(A,*(I6))') " p%iy1 = ", p%iy1 + write (DebugUn, *) "shape(m%dYdx) = ", shape(m%Mod%Lin%dYdx) + write (DebugUn, *) "shape(m%dYdu) = ", shape(m%Mod%Lin%dYdu) + write (DebugUn, *) "shape(m%dXdx) = ", shape(m%Mod%Lin%dXdx) + write (DebugUn, *) "shape(m%dXdu) = ", shape(m%Mod%Lin%dXdu) + write (DebugUn, *) "shape(m%dUdu) = ", shape(m%Mod%Lin%dUdu) + write (DebugUn, *) "shape(m%dUdy) = ", shape(m%Mod%Lin%dUdy) + + do j = 1, size(m%Mod%Vars%x) + write (DebugUn, *) "Var = X "//trim(m%Mod%Vars%x(j)%Name)// & + " ("//trim(MV_FieldString(m%Mod%Vars%x(j)%Field))//")" + write (DebugUn, '(A,*(I6))') " X iLoc = ", m%Mod%Vars%x(j)%iLoc + write (DebugUn, '(A,*(I6))') " X iq = ", m%Mod%Vars%x(j)%iGlu + end do + do j = 1, size(m%Mod%Vars%u) + write (DebugUn, *) "Var = U "//trim(m%Mod%Vars%u(j)%Name)// & + " ("//trim(MV_FieldString(m%Mod%Vars%u(j)%Field))//")" + write (DebugUn, '(A,*(I6))') " U iLoc = ", m%Mod%Vars%u(j)%iLoc + end do + do j = 1, size(m%Mod%Vars%y) + write (DebugUn, *) "Var = Y "//trim(m%Mod%Vars%y(j)%Name)// & + " ("//trim(MV_FieldString(m%Mod%Vars%y(j)%Field))//")" + write (DebugUn, '(A,*(I6))') " Y iLoc = ", m%Mod%Vars%y(j)%iLoc + end do + + do i = 1, size(GlueModMaps) + associate (SrcMod => GlueModData(GlueModMaps(i)%iModSrc), & + DstMod => GlueModData(GlueModMaps(i)%iModDst)) + write (DebugUn, *) "Mapping = "//GlueModMaps(i)%Desc + write (DebugUn, *) " Src = "//trim(SrcMod%Abbr)//' Ins:'//trim(num2lstr(SrcMod%Ins))//' iMod:'//trim(num2lstr(SrcMod%iMod)) + write (DebugUn, *) " Dst = "//trim(DstMod%Abbr)//' Ins:'//trim(num2lstr(DstMod%Ins))//' iMod:'//trim(num2lstr(DstMod%iMod)) + end associate + end do +end subroutine + +subroutine Solver_Step_Debug(p, m, step, iterCorr, iterConv, delta_norm) + type(Glue_TCParam), intent(in) :: p !< Parameters + type(Glue_TCMisc), intent(in) :: m !< Misc variables + integer(IntKi), intent(in) :: step + integer(IntKi), intent(in) :: iterCorr + integer(IntKi), intent(in) :: iterConv + real(R8Ki), intent(in) :: delta_norm + + write (DebugUn, *) "step = ", step + write (DebugUn, *) "iterCorr = ", iterCorr + write (DebugUn, *) "iterConv = ", iterConv + if (p%iJX(1) > 0) write (DebugUn, '(A,*(ES16.7))') " delta_x = ", m%XB(p%iJX(1):p%iJX(2), 1) + if (p%iJU(1) > 0) write (DebugUn, '(A,*(ES16.7))') " delta_u = ", m%XB(p%iJU(1):p%iJU(2), 1) + if (allocated(m%uCalc)) write (DebugUn, '(A,*(ES16.7))') " uCalc = ", m%uCalc + if (allocated(m%Mod%Lin%x)) write (DebugUn, '(A,*(ES16.7))') " x = ", m%Mod%Lin%x + if (allocated(m%Mod%Lin%u)) write (DebugUn, '(A,*(ES16.7))') " u = ", m%Mod%Lin%u + write (DebugUn, *) "delta_norm = ", delta_norm +end subroutine + +subroutine BuildJacobian_Debug(m, T, ErrStat, ErrMsg) + type(Glue_TCMisc), intent(inout) :: m !< Misc variables + type(FAST_TurbineType), intent(in) :: T !< Turbine + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'BuildJacobian_Debug' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + if (MatrixUn == -1) then + call GetNewUnit(MatrixUn, ErrStat2, ErrMsg2); if (Failed()) return + end if + + ! Write module matrices to file + do i = 1, size(m%Mod%ModData) + associate (ModData => m%Mod%ModData(i)) + call CalcWriteLinearMatrices(ModData%Vars, ModData%Lin, T%p_FAST, T%y_FAST, 0.0_R8Ki, MatrixUn, "SolverTC", VF_None, ErrStat2, ErrMsg2, & + CalcGlue=.false., ModSuffix=ModData%Abbr, FullOutput=.true.) + if (Failed()) return + end associate + end do + + ! Write glue code matrices to file + call CalcWriteLinearMatrices(m%Mod%Vars, m%Mod%Lin, T%p_FAST, T%y_FAST, 0.0_R8Ki, MatrixUn, "SolverTC", VF_None, ErrStat2, ErrMsg2, CalcGlue=.false., FullOutput=.true.) + if (Failed()) return + + ! call DumpMatrix(MatrixUn, "dUdu.bin", m%Mod%Lin%dUdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "dUdy.bin", m%Mod%Lin%dUdy, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "dXdu.bin", m%Mod%Lin%dXdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "dXdx.bin", m%Mod%Lin%dXdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "dYdu.bin", m%Mod%Lin%dYdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "dYdx.bin", m%Mod%Lin%dYdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "ED-dXdu.bin", T%ED%m%Vals%dXdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "ED-dXdx.bin", T%ED%m%Vals%dXdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "ED-dYdu.bin", T%ED%m%Vals%dYdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "ED-dYdx.bin", T%ED%m%Vals%dYdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "BD-dXdu.bin", T%BD%m(1)%Vals%dXdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "BD-dXdx.bin", T%BD%m(1)%Vals%dXdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "BD-dYdu.bin", T%BD%m(1)%Vals%dYdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "BD-dYdx.bin", T%BD%m(1)%Vals%dYdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(MatrixUn, "J.bin", m%Mod%Lin%J, ErrStat2, ErrMsg2); if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +end module diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 67cde541c4..447126e1a8 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -3,7 +3,7 @@ ! FAST_Prog.f90, FAST_Library.f90, FAST_Prog.c are different drivers for this code. !.................................................................................................................................. ! LICENSING -! Copyright (C) 2013-2016 National Renewable Energy Laboratory +! Copyright (C) 2013-2024 National Renewable Energy Laboratory ! ! This file is part of FAST. ! @@ -21,20 +21,27 @@ !********************************************************************************************************************************** MODULE FAST_Subs - USE FAST_Solver - USE FAST_Linear - USE SC_DataEx + USE FAST_Types + USE FAST_ModTypes + USE FAST_ModGlue USE VersionInfo + USE FAST_Funcs + USE FAST_SolverTC + USE FAST_Mapping, only: FAST_InitMappings + USE SC_DataEx + USE ServoDyn IMPLICIT NONE + INTEGER(IntKi), private, parameter :: iED = 1 + INTEGER(IntKi), private, parameter :: NumED = 1 + CONTAINS !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! INITIALIZATION ROUTINES !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> a wrapper routine to call FAST_Initialize at the full-turbine simulation level (makes easier to write top-level driver) SUBROUTINE FAST_InitializeAll_T( t_initial, TurbID, Turbine, ErrStat, ErrMsg, InFile, ExternInitData ) - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time INTEGER(IntKi), INTENT(IN ) :: TurbID !< turbine Identifier (1-NumTurbines) TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine @@ -46,36 +53,37 @@ SUBROUTINE FAST_InitializeAll_T( t_initial, TurbID, Turbine, ErrStat, ErrMsg, In LOGICAL, PARAMETER :: CompAeroMaps = .false. Turbine%TurbID = TurbID - - IF (PRESENT(InFile)) THEN - IF (PRESENT(ExternInitData)) THEN - CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX,& - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg, InFile, ExternInitData ) - ELSE - CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg, InFile ) - END IF - ELSE - CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg ) - END IF - + CALL FAST_InitializeAll( t_initial, Turbine%m_Glue, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX,& + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg, InFile, ExternInitData ) + if(ErrStat >= AbortErrLev) return + + ! Initialize mappings between modules + call FAST_InitMappings(Turbine%m_Glue%Mappings, Turbine%m_Glue%ModData, Turbine, ErrStat, ErrMsg) + if(ErrStat >= AbortErrLev) return + + ! Initialize solver + call FAST_SolverInit(Turbine%p_FAST, Turbine%p_Glue%TC, Turbine%m_Glue%TC, & + Turbine%m_Glue%ModData, Turbine%m_Glue%Mappings, Turbine, ErrStat, ErrMsg) + if(ErrStat >= AbortErrLev) return + + ! Initialize overall glue module for linearization + if (Turbine%p_FAST%Linearize) then + call ModGlue_Init(Turbine%p_Glue, Turbine%m_Glue, Turbine%y_Glue, & + Turbine%p_FAST, Turbine%m_FAST, Turbine, ErrStat, ErrMsg) + end if END SUBROUTINE FAST_InitializeAll_T !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to call Init routine for each module. This routine sets all of the init input data for each module. -SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SC_DX, SeaSt, HD, SD, ExtPtfm, & +SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SC_DX, SeaSt, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, CompAeroMaps, ErrStat, ErrMsg, InFile, ExternInitData ) use ElastoDyn_Parameters, only: Method_RK4 REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + TYPE(Glue_MiscVarType), INTENT(INOUT) :: m_Glue !< Miscellaneous variables glue code 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 @@ -123,15 +131,18 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S INTEGER(IntKi) :: IceDim ! dimension we're pre-allocating for number of IceDyn legs/instances INTEGER(IntKi) :: I ! generic loop counter INTEGER(IntKi) :: k ! blade loop counter + INTEGER(IntKi) :: InputAryLB ! Input array lower bound + INTEGER(IntKi) :: InputAryUB ! Input array upper bound + INTEGER(IntKi) :: StateAryLB ! States array lower bound + INTEGER(IntKi) :: StateAryUB ! States array upper bound logical :: CallStart REAL(R8Ki) :: theta(3) ! angles for hub orientation matrix for aeromaps INTEGER(IntKi) :: NumBl - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitializeAll' + CHARACTER(ErrMsgLen) :: ErrMsg2 !.......... @@ -164,8 +175,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S p_FAST%TDesc = '' ! p_FAST%CheckHSSBrTrqC = .false. - y_FAST%Lin%WindSpeed = 0.0_ReKi - if (present(ExternInitData)) then CallStart = .not. ExternInitData%FarmIntegration if (ExternInitData%TurbIDforName >= 0) p_FAST%TDesc = 'T'//trim(num2lstr(ExternInitData%TurbIDforName)) @@ -227,20 +236,43 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S END IF - !............................................................................................................................... - p_FAST%dt_module = p_FAST%dt ! initialize time steps for each module - if (p_FAST%CompElast == Module_SED) then - ! ........................ - ! initialize Simplified-ElastoDyn (must be done first) - ! ........................ - ALLOCATE( SED%Input( p_FAST%InterpOrder+1 ), SED%InputTimes( p_FAST%InterpOrder+1 ),STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating SED%Input and SED%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + !---------------------------------------------------------------------------- + ! Module data arrays + !---------------------------------------------------------------------------- + + ! Input array upper bound is interpolation order plus 1 + InputAryUB = p_FAST%InterpOrder + 1 + + ! Input array lower bound is negative (sum of linearization times and upper bound) + InputAryLB = -(InputAryUB + max(p_FAST%NLinTimes, 2)) + + ! Module data state arrays include data at linearization times after + ! STATE_CURR, STATE_PRED, STATE_SAVED_CURR, and STATE_SAVED_PRED + StateAryLB = 1 + StateAryUB = NumStateTimes + max(p_FAST%NLinTimes, 2) + + !---------------------------------------------------------------------------- + ! Linearization + !---------------------------------------------------------------------------- + + y_FAST%Lin%WindSpeed = 0.0_ReKi + + !---------------------------------------------------------------------------- + ! Initialize ElastoDyn/SED (must be done first) + !---------------------------------------------------------------------------- + + select case (p_FAST%CompElast) + + case (Module_SED) ! Simplified-ElastoDyn + + allocate(SED%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("SED%Input")) return + allocate(SED%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("SED%InputTimes")) return + allocate(SED%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SED%x")) return + allocate(SED%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SED%xd")) return + allocate(SED%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SED%z")) return + allocate(SED%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SED%OtherSt")) return Init%InData_SED%Linearize = p_FAST%Linearize Init%InData_SED%InputFile = p_FAST%EDFile @@ -248,249 +280,181 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S CALL SED_Init( Init%InData_SED, SED%Input(1), SED%p, SED%x(STATE_CURR), SED%xd(STATE_CURR), SED%z(STATE_CURR), SED%OtherSt(STATE_CURR), & SED%y, SED%m, p_FAST%dt_module( MODULE_SED ), Init%OutData_SED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - p_FAST%ModuleInitialized(Module_SED) = .TRUE. - CALL SetModuleSubstepTime(Module_SED, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return + + ! Add module to array of modules, return if errors occurred + CALL MV_AddModule(m_Glue%ModData, Module_SED, 'SED', 1, p_FAST%dt_module(Module_SED), p_FAST%DT, & + Init%OutData_SED%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) + if (Failed()) return NumBl = Init%OutData_SED%NumBl + + p_FAST%ModuleInitialized(Module_SED) = .TRUE. - else - ! ........................ - ! initialize ElastoDyn (must be done first) - ! ........................ - 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 and ED%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + case default ! ElastoDyn + + ! Allocate module data arrays + allocate(ED%Input (InputAryLB:InputAryUB, NumED), stat=ErrStat2); if (FailedAlloc("ED%Input")) return + allocate(ED%InputTimes (InputAryUB, NumED ), stat=ErrStat2); if (FailedAlloc("ED%InputTimes")) return + allocate(ED%x (NumED, StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%x")) return + allocate(ED%xd (NumED, StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%xd")) return + allocate(ED%z (NumED, StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%z")) return + allocate(ED%OtherSt (NumED, StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%OtherSt")) return + allocate(ED%p (NumED ), stat=ErrStat2); if (FailedAlloc("ED%p")) return + allocate(ED%y (NumED ), stat=ErrStat2); if (FailedAlloc("ED%y")) return + allocate(ED%m (NumED ), stat=ErrStat2); if (FailedAlloc("ED%m")) return + + allocate(Init%OutData_ED(NumED ), stat=ErrStat2); if (FailedAlloc("Init%OutData_ED")) return - ALLOCATE( ED%Input_Saved( p_FAST%InterpOrder+1 ), ED%InputTimes_Saved( p_FAST%InterpOrder+1 ), ED%Output_bak( p_FAST%InterpOrder+1 ),STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating ED%Input_Saved, ED%Output_bak, and ED%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - + ! Set initialization input Init%InData_ED%Linearize = p_FAST%Linearize Init%InData_ED%CompAeroMaps = p_FAST%CompAeroMaps Init%InData_ED%RotSpeed = p_FAST%RotSpeedInit Init%InData_ED%InputFile = p_FAST%EDFile - + Init%InData_ED%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_ED)) Init%InData_ED%CompElast = p_FAST%CompElast == Module_ED - Init%InData_ED%Gravity = p_FAST%Gravity - Init%InData_ED%MHK = p_FAST%MHK Init%InData_ED%WtrDpth = p_FAST%WtrDpth - - 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) - + + ! Call module initialization routine + CALL ED_Init(Init%InData_ED, ED%Input(1, iED), ED%p(iED), ED%x(iED, STATE_CURR), & + ED%xd(iED, STATE_CURR), ED%z(iED, STATE_CURR), ED%OtherSt(iED, STATE_CURR), & + ED%y(iED), ED%m(iED), p_FAST%dt_module(MODULE_ED), Init%OutData_ED(iED), ErrStat2, ErrMsg2) + if (Failed()) return + + ! Add module to array of modules, return if errors occurred + CALL MV_AddModule(m_Glue%ModData, Module_ED, 'ED', 1, p_FAST%dt_module(Module_ED), p_FAST%DT, & + Init%OutData_ED(iED)%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) + if (Failed()) return p_FAST%ModuleInitialized(Module_ED) = .TRUE. - CALL SetModuleSubstepTime(Module_ED, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - allocate( y_FAST%Lin%Modules(MODULE_ED)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(ED).", ErrStat, ErrMsg, RoutineName ) - else - - 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(Init%OutData_ED%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%NumOutputs = size(Init%OutData_ED%WriteOutputHdr) - end if - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - NumBl = Init%OutData_ED%NumBl - p_FAST%GearBox_index = Init%OutData_ED%GearBox_index - - + + NumBl = Init%OutData_ED(iED)%NumBl + p_FAST%GearBox_index = Init%OutData_ED(iED)%GearBox_index + if (p_FAST%CalcSteady) then - if ( EqualRealNos(Init%OutData_ED%RotSpeed, 0.0_ReKi) ) then + if ( EqualRealNos(Init%OutData_ED(iED)%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 + elseif ( Init%OutData_ED(iED)%isFixed_GenDOF ) then p_FAST%TrimCase = TrimCase_none end if end if - endif ! SED/ED + end select ! SED/ED - ! ........................ - ! initialize BeamDyn - ! ........................ - IF ( p_FAST%CompElast == Module_BD ) THEN - IF (p_FAST%CompAeroMaps) then - p_FAST%nBeams = 1 ! initialize number of BeamDyn instances = 1 blade for aero maps - ELSE - p_FAST%nBeams = Init%OutData_ED%NumBl ! initialize number of BeamDyn instances = number of blades - END IF - ELSE - p_FAST%nBeams = 0 - END IF - - ALLOCATE( BD%Input( p_FAST%InterpOrder+1, p_FAST%nBeams ), BD%InputTimes( p_FAST%InterpOrder+1, p_FAST%nBeams ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating BD%Input and BD%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - ALLOCATE( BD%Input_Saved( p_FAST%InterpOrder+1, p_FAST%nBeams ), BD%InputTimes_Saved( p_FAST%InterpOrder+1, p_FAST%nBeams ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating BD%Input_Saved and BD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + !---------------------------------------------------------------------------- + ! Initialize BeamDyn + !---------------------------------------------------------------------------- - ALLOCATE( BD%x( p_FAST%nBeams,4), & - BD%xd( p_FAST%nBeams,4), & - BD%z( p_FAST%nBeams,4), & - BD%OtherSt( p_FAST%nBeams,4), & - BD%p( p_FAST%nBeams ), & - BD%u( p_FAST%nBeams ), & - BD%y( p_FAST%nBeams ), & - BD%m( 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) - CALL Cleanup() - RETURN - END IF + if (p_FAST%CompElast == Module_BD) then + if (p_FAST%CompAeroMaps) then + p_FAST%nBeams = 1 ! initialize number of BeamDyn instances = 1 blade for aero maps + else + p_FAST%nBeams = Init%OutData_ED(iED)%NumBl ! initialize number of BeamDyn instances = number of blades + end if + else + p_FAST%nBeams = 0 + end if - IF (p_FAST%CompElast == Module_BD) THEN + ! Allocate module data arrays + allocate(BD%Input (InputAryLB:InputAryUB, p_FAST%nBeams), stat=ErrStat2); if (FailedAlloc("BD%Input")) return + allocate(BD%InputTimes (InputAryUB, p_FAST%nBeams), stat=ErrStat2); if (FailedAlloc("BD%InputTimes")) return + allocate(BD%x (p_FAST%nBeams, StateAryUB ), stat=ErrStat2); if (FailedAlloc("BD%x")) return + allocate(BD%xd (p_FAST%nBeams, StateAryUB ), stat=ErrStat2); if (FailedAlloc("BD%xd")) return + allocate(BD%z (p_FAST%nBeams, StateAryUB ), stat=ErrStat2); if (FailedAlloc("BD%z")) return + allocate(BD%OtherSt (p_FAST%nBeams, StateAryUB ), stat=ErrStat2); if (FailedAlloc("BD%OtherSt")) return + allocate(BD%p (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%p")) return + allocate(BD%y (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%y")) return + allocate(BD%m (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("BD%m")) return - Init%InData_BD%DynamicSolve = .TRUE. ! FAST can only couple to BeamDyn when dynamic solve is used. + allocate(Init%OutData_BD (p_FAST%nBeams ), stat=ErrStat2); if (FailedAlloc("Init%OutData_BD")) return - Init%InData_BD%Linearize = p_FAST%Linearize - Init%InData_BD%CompAeroMaps = p_FAST%CompAeroMaps - Init%InData_BD%gravity = (/ 0.0_ReKi, 0.0_ReKi, -p_FAST%Gravity /) ! "Gravitational acceleration" m/s^2 + if (p_FAST%CompElast == Module_BD) then - ! now initialize BeamDyn for all beams - dt_BD = p_FAST%dt_module( MODULE_BD ) + ! Set initialization input + Init%InData_BD%DynamicSolve = .TRUE. ! FAST can only couple to BeamDyn when dynamic solve is used. + Init%InData_BD%Linearize = p_FAST%Linearize + Init%InData_BD%CompAeroMaps = p_FAST%CompAeroMaps + Init%InData_BD%gravity = [0.0_ReKi, 0.0_ReKi, -p_FAST%Gravity] ! "Gravitational acceleration" m/s^2 + Init%InData_BD%HubPos = ED%y(iED)%HubPtMotion%Position(:,1) + Init%InData_BD%HubRot = ED%y(iED)%HubPtMotion%RefOrientation(:,:,1) - Init%InData_BD%HubPos = ED%y%HubPtMotion%Position(:,1) - Init%InData_BD%HubRot = ED%y%HubPtMotion%RefOrientation(:,:,1) + ! now initialize BeamDyn for all beams + dt_BD = p_FAST%dt_module(MODULE_BD) p_FAST%BD_OutputSibling = .true. - allocate( y_FAST%Lin%Modules(MODULE_BD)%Instance(p_FAST%nBeams), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(BD).", ErrStat, ErrMsg, RoutineName ) - CALL Cleanup() - RETURN - end if - - DO k=1,p_FAST%nBeams - Init%InData_BD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_BD))//TRIM( Num2LStr(k) ) - + DO k = 1, p_FAST%nBeams + Init%InData_BD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_BD))//TRIM(Num2LStr(k)) Init%InData_BD%InputFile = p_FAST%BDBldFile(k) + Init%InData_BD%GlbPos = ED%y(iED)%BladeRootMotion(k)%Position(:,1) ! {:} - - "Initial Position Vector of the local blade coordinate system" + Init%InData_BD%GlbRot = ED%y(iED)%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" - - ! These outputs are set in ElastoDyn only when BeamDyn is used: - 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" + ! These outputs are set in ElastoDyn only when BeamDyn is used: + Init%InData_BD%RootDisp = ED%y(iED)%BladeRootMotion(k)%TranslationDisp(:,1) ! {:} - - "Initial root displacement" + Init%InData_BD%RootOri = ED%y(iED)%BladeRootMotion(k)%Orientation(:,:,1) ! {:}{:} - - "Initial root orientation" + Init%InData_BD%RootVel(1:3) = ED%y(iED)%BladeRootMotion(k)%TranslationVel(:,1) ! {:} - - "Initial root velocities and angular velocities" + Init%InData_BD%RootVel(4:6) = ED%y(iED)%BladeRootMotion(k)%RotationVel(:,1) ! {:} - - "Initial root velocities and angular velocities" - 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) + ! Call module initialization routine + 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) + if (Failed()) return !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. - IF ( k == 1 ) THEN - p_FAST%dt_module( MODULE_BD ) = dt_BD - + IF (k == 1) THEN + p_FAST%dt_module(MODULE_BD) = dt_BD p_FAST%ModuleInitialized(Module_BD) = .TRUE. ! this really should be once per BD instance, but BD doesn't care so I won't go through the effort to track this CALL SetModuleSubstepTime(Module_BD, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - 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) + ELSEIF (.NOT. EqualRealNos(p_FAST%dt_module(MODULE_BD), dt_BD)) THEN + ErrStat2 = ErrID_Fatal + ErrMsg2 = "All instances of BeamDyn (one per blade) must have the same time step." END IF + if (Failed()) return - ! We're going to do fewer computations if the BD input and output meshes that couple to AD are siblings (but it needs to be true for all instances): + ! We're going to do fewer computations if the BD input and output meshes that couple to AD are siblings (but it needs to be true for all instances): if (BD%p(k)%BldMotionNodeLoc /= BD_MESH_QP) p_FAST%BD_OutputSibling = .false. - if (p_FAST%CompAeroMaps .and. BD%p(k)%BldMotionNodeLoc /= BD_MESH_FE) call SetErrStat(ErrID_Fatal, "BeamDyn aero maps must have outputs at FE nodes.", ErrStat, ErrMsg, RoutineName ) - - if (ErrStat>=AbortErrLev) exit !exit this loop so we don't get p_FAST%nBeams of the same errors - - if (size(y_FAST%Lin%Modules(MODULE_BD)%Instance) >= k) then ! for aero maps, we only use the first instance: - 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(Init%OutData_BD(k)%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%NumOutputs = size(Init%OutData_BD(k)%WriteOutputHdr) - end if + if (p_FAST%CompAeroMaps .and. BD%p(k)%BldMotionNodeLoc /= BD_MESH_FE) call SetErrStat(ErrID_Fatal, "BeamDyn aero maps must have outputs at FE nodes.", ErrStat, ErrMsg, RoutineName) + ! Add module instance to array of modules, return on failure + CALL MV_AddModule(m_Glue%ModData, Module_BD, 'BD', k, p_FAST%dt_module(Module_BD), & + p_FAST%DT, Init%OutData_BD(k)%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) + if (Failed()) return + END DO - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - END IF - - ! ........................ - ! initialize InflowWind - ! ........................ - ALLOCATE( IfW%Input( p_FAST%InterpOrder+1 ), IfW%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating IfW%Input and IfW%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ALLOCATE( IfW%Input_Saved( p_FAST%InterpOrder+1 ), IfW%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating IfW%Input_Saved and IfW%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - IF ( p_FAST%CompInflow == Module_IfW ) THEN - - 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%FilePassingMethod= 0_IntKi ! IfW will read input file - Init%InData_IfW%FixedWindFileRootName = .FALSE. - Init%InData_IfW%OutputAccel = p_FAST%MHK /= MHK_None - - Init%InData_IfW%MHK = p_FAST%MHK - Init%InData_IfW%WtrDpth = p_FAST%WtrDpth - - Init%InData_IfW%NumWindPoints = 0 + !---------------------------------------------------------------------------- + ! Initialize InflowWind + !---------------------------------------------------------------------------- + + ! Allocate module data arrays + allocate(IfW%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("IfW%Input")) return + allocate(IfW%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("IfW%InputTimes")) return + allocate(IfW%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IfW%x")) return + allocate(IfW%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IfW%xd")) return + allocate(IfW%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IfW%z")) return + allocate(IfW%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IfW%OtherSt")) return + + select case(p_FAST%CompInflow) + case (Module_IfW) + + 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%FilePassingMethod = 0_IntKi ! IfW will read input file + Init%InData_IfW%FixedWindFileRootName = .FALSE. + Init%InData_IfW%OutputAccel = p_FAST%MHK /= MHK_None + Init%InData_IfW%MHK = p_FAST%MHK + Init%InData_IfW%WtrDpth = p_FAST%WtrDpth - IF ( p_FAST%CompServo == Module_SrvD ) THEN + Init%InData_IfW%NumWindPoints = 0 + IF (p_FAST%CompServo == Module_SrvD) THEN Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + 1 END IF @@ -501,14 +465,14 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S Init%InData_IfW%lidar%HubPosition = SED%y%HubPtMotion%Position(:,1) Init%InData_IfW%RadAvg = Init%OutData_SED%BladeLength elseif ( p_FAST%CompElast == Module_ED ) then - Init%InData_IfW%lidar%HubPosition = ED%y%HubPtMotion%Position(:,1) - Init%InData_IfW%RadAvg = Init%OutData_ED%BladeLength + Init%InData_IfW%lidar%HubPosition = ED%y(iED)%HubPtMotion%Position(:,1) + Init%InData_IfW%RadAvg = Init%OutData_ED(iED)%BladeLength elseif ( p_FAST%CompElast == Module_BD ) then - Init%InData_IfW%lidar%HubPosition = ED%y%HubPtMotion%Position(:,1) + Init%InData_IfW%lidar%HubPosition = ED%y(iED)%HubPtMotion%Position(:,1) Init%InData_IfW%RadAvg = TwoNorm(BD%y(1)%BldMotion%Position(:,1) - BD%y(1)%BldMotion%Position(:,BD%y(1)%BldMotion%Nnodes)) end if - IF ( PRESENT(ExternInitData) ) THEN + IF (PRESENT(ExternInitData)) THEN Init%InData_IfW%Use4Dext = ExternInitData%FarmIntegration if (Init%InData_IfW%Use4Dext) then @@ -518,7 +482,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S Init%InData_IfW%FDext%Vel => ExternInitData%windGrid_data end if ELSE - Init%InData_IfW%Use4Dext = .false. + Init%InData_IfW%Use4Dext = .false. END IF ! OLAF might be used in AD, in which case we need to allow out of bounds for some calcs. To do that @@ -528,86 +492,78 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S Init%InData_IfW%BoxExceedAllow = .true. endif - 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) + ! Call module initialization routine + 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) + if (Failed()) return - p_FAST%ModuleInitialized(Module_IfW) = .TRUE. - CALL SetModuleSubstepTime(Module_IfW, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - allocate( y_FAST%Lin%Modules(MODULE_IfW)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(IfW).", ErrStat, ErrMsg, RoutineName ) - else - 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 + y_FAST%Lin%WindSpeed = Init%OutData_IfW%WindFileInfo%MWS - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + ! Add module to list of modules, return on error + CALL MV_AddModule(m_Glue%ModData, Module_IfW, 'IfW', 1, p_FAST%dt_module(Module_IfW), p_FAST%DT, & + Init%OutData_IfW%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) + if (Failed()) return + p_FAST%ModuleInitialized(Module_IfW) = .TRUE. - ELSEIF ( p_FAST%CompInflow == Module_ExtInfw ) THEN + case (Module_ExtInfw) ! ExtInfw requires initialization of AD first, so nothing executed here - ELSE + case default Init%OutData_IfW%WindFileInfo%MWS = 0.0_ReKi - END IF ! CompInflow + end select ! CompInflow - ! ........................ - ! initialize SeaStates - ! ........................ - ALLOCATE( SeaSt%Input( p_FAST%InterpOrder+1 ), SeaSt%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating SeaSt%Input and SeaSt%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + !---------------------------------------------------------------------------- + ! Initialize SeaStates + !---------------------------------------------------------------------------- - ALLOCATE( SeaSt%Input_Saved( p_FAST%InterpOrder+1 ), SeaSt%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating SeaSt%Input_Saved and SeaSt%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + ! Allocate module data arrays + allocate(SeaSt%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("SeaSt%Input")) return + allocate(SeaSt%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("SeaSt%InputTimes")) return + allocate(SeaSt%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SeaSt%x")) return + allocate(SeaSt%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SeaSt%xd")) return + allocate(SeaSt%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SeaSt%z")) return + allocate(SeaSt%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SeaSt%OtherSt")) return if ( p_FAST%CompSeaSt == Module_SeaSt ) then + Init%InData_SeaSt%TMax = p_FAST%TMax Init%InData_SeaSt%Gravity = p_FAST%Gravity Init%InData_SeaSt%defWtrDens = p_FAST%WtrDens Init%InData_SeaSt%defWtrDpth = p_FAST%WtrDpth Init%InData_SeaSt%defMSL2SWL = p_FAST%MSL2SWL + Init%InData_SeaSt%MHK = p_FAST%MHK Init%InData_SeaSt%UseInputFile = .TRUE. Init%InData_SeaSt%Linearize = p_FAST%Linearize Init%InData_SeaSt%hasIce = p_FAST%CompIce /= Module_None Init%InData_SeaSt%InputFile = p_FAST%SeaStFile Init%InData_SeaSt%OutRootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_SeaSt)) - ! these values support wave field handling + ! these values support wave field handling Init%InData_SeaSt%WaveFieldMod = p_FAST%WaveFieldMod Init%InData_SeaSt%PtfmLocationX = p_FAST%TurbinePos(1) Init%InData_SeaSt%PtfmLocationY = p_FAST%TurbinePos(2) - Init%InData_SeaSt%TMax = p_FAST%TMax + IF ( p_FAST%MHK .NE. 0_IntKi .AND. p_FAST%CompInflow == Module_IfW) THEN + Init%InData_SeaSt%hasCurrField = .TRUE. + ELSE + Init%InData_SeaSt%hasCurrField = .FALSE. + END IF + ! wave field visualization if (p_FAST%WrVTK == VTK_Animate .and. p_FAST%VTK_Type == VTK_Surf) Init%InData_SeaSt%SurfaceVis = .true. - - CALL SeaSt_Init( Init%InData_SeaSt, SeaSt%Input(1), SeaSt%p, SeaSt%x(STATE_CURR), SeaSt%xd(STATE_CURR), SeaSt%z(STATE_CURR), & - SeaSt%OtherSt(STATE_CURR), SeaSt%y, SeaSt%m, p_FAST%dt_module( MODULE_SeaSt ), Init%OutData_SeaSt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! Call module initialization routine + CALL SeaSt_Init(Init%InData_SeaSt, SeaSt%Input(1), SeaSt%p, SeaSt%x(STATE_CURR), SeaSt%xd(STATE_CURR), SeaSt%z(STATE_CURR), & + SeaSt%OtherSt(STATE_CURR), SeaSt%y, SeaSt%m, p_FAST%dt_module(MODULE_SeaSt), Init%OutData_SeaSt, ErrStat2, ErrMsg2) + if (Failed()) return p_FAST%ModuleInitialized(Module_SeaSt) = .TRUE. - CALL SetModuleSubstepTime(Module_SeaSt, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! Add module to array, return on error + call MV_AddModule(m_Glue%ModData, Module_SeaSt, 'SEA', 1, p_FAST%dt_module(Module_SeaSt), p_FAST%DT, & + Init%OutData_SeaSt%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) + if (Failed()) return if (allocated(Init%OutData_SeaSt%WaveElevVisGrid)) then p_FAST%VTK_surface%NWaveElevPts(1) = size(Init%OutData_SeaSt%WaveElevVisX) @@ -617,69 +573,38 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S p_FAST%VTK_surface%NWaveElevPts(2) = 0 endif - allocate( y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(SeaSt).", ErrStat, ErrMsg, RoutineName ) - else - if (allocated(Init%OutData_SeaSt%LinNames_y)) call move_alloc(Init%OutData_SeaSt%LinNames_y,y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%Names_y ) - if (allocated(Init%OutData_SeaSt%LinNames_u)) call move_alloc(Init%OutData_SeaSt%LinNames_u,y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%Names_u ) - if (allocated(Init%OutData_SeaSt%RotFrame_y)) call move_alloc(Init%OutData_SeaSt%RotFrame_y,y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%RotFrame_y ) - if (allocated(Init%OutData_SeaSt%RotFrame_u)) call move_alloc(Init%OutData_SeaSt%RotFrame_u,y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%RotFrame_u ) - if (allocated(Init%OutData_SeaSt%IsLoad_u )) call move_alloc(Init%OutData_SeaSt%IsLoad_u ,y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%IsLoad_u ) - - if (allocated(Init%OutData_SeaSt%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%NumOutputs = size(Init%OutData_SeaSt%WriteOutputHdr) - end if - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - + IF ( p_FAST%MHK .NE. 0_IntKi .AND. p_FAST%CompInflow == Module_IfW) THEN ! MHK turbine with dynamic current + ! Simulating an MHK turbine; load dynamic current from IfW + SeaSt%p%WaveField%CurrField => Init%OutData_IfW%FlowField + SeaSt%p%WaveField%hasCurrField = .TRUE. + ELSE ! Wind turbine + SeaSt%p%WaveField%hasCurrField = .FALSE. + END IF end if + !---------------------------------------------------------------------------- + ! Initialize AeroDyn / ADsk + !---------------------------------------------------------------------------- - ! ........................ - ! initialize AeroDyn / ADsk - ! ........................ - ALLOCATE( AD%Input( p_FAST%InterpOrder+1 ), AD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating AD%Input and AD%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ALLOCATE( AD%Input_Saved( p_FAST%InterpOrder+1 ), AD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating AD%Input and AD%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + select case (p_FAST%CompAero) - ALLOCATE( ADsk%Input( p_FAST%InterpOrder+1 ), ADsk%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating ADsk%Input and ADsk%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + case (Module_AD, Module_ExtLd) - IF ( (p_FAST%CompAero == Module_AD) .OR. (p_FAST%CompAero == Module_ExtLd) ) THEN + ! Allocate module data arrays + allocate(AD%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("AD%Input")) return + allocate(AD%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("AD%InputTimes")) return + allocate(AD%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("AD%x")) return + allocate(AD%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("AD%xd")) return + allocate(AD%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("AD%z")) return + allocate(AD%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("AD%OtherSt")) return - allocate(Init%InData_AD%rotors(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat( ErrID_Fatal, 'Allocating rotors', errStat, errMsg, RoutineName ) - call Cleanup() - return - end if + allocate(Init%InData_AD%rotors(1), stat=ErrStat2); if (FailedAlloc("AD%Init%InData_AD%rotors(1)")) return Init%InData_AD%rotors(1)%NumBlades = NumBl if (p_FAST%CompAeroMaps) then CALL AllocAry( MeshMapData%HubOrient, 3, 3, Init%InData_AD%rotors(1)%NumBlades, 'Hub orientation matrix', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + if (Failed()) return theta = 0.0_R8Ki do k=1,Init%InData_AD%rotors(1)%NumBlades @@ -688,16 +613,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S end do end if + ! set initialization data for AD + call AllocAry( Init%InData_AD%rotors(1)%BladeRootPosition, 3, Init%InData_AD%rotors(1)%NumBlades, 'Init%InData_AD%rotors(1)%BladeRootPosition', errStat2, ErrMsg2) + if (Failed()) return - ! set initialization data for AD - CALL AllocAry( Init%InData_AD%rotors(1)%BladeRootPosition, 3, Init%InData_AD%rotors(1)%NumBlades, 'Init%InData_AD%rotors(1)%BladeRootPosition', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry( Init%InData_AD%rotors(1)%BladeRootOrientation,3, 3, Init%InData_AD%rotors(1)%NumBlades, 'Init%InData_AD%rotors(1)%BladeRootOrientation', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + call AllocAry( Init%InData_AD%rotors(1)%BladeRootOrientation,3, 3, Init%InData_AD%rotors(1)%NumBlades, 'Init%InData_AD%rotors(1)%BladeRootOrientation', errStat2, ErrMsg2) + if (Failed()) return Init%InData_AD%Gravity = p_FAST%Gravity Init%InData_AD%Linearize = p_FAST%Linearize @@ -706,6 +627,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S Init%InData_AD%InputFile = p_FAST%AeroFile Init%InData_AD%RootName = p_FAST%OutFileRoot Init%InData_AD%MHK = p_FAST%MHK + Init%InData_AD%CompSeaSt = p_FAST%CompSeaSt if ( p_FAST%MHK == MHK_None ) then Init%InData_AD%defFldDens = p_FAST%AirDens else @@ -729,13 +651,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S Init%InData_AD%rotors(1)%BladeRootOrientation(:,:,k) = SED%y%BladeRootMotion(k)%RefOrientation(:,:,1) end do elseif (p_FAST%CompElast == Module_ED .or. p_FAST%CompElast == Module_BD) then - Init%InData_AD%rotors(1)%HubPosition = ED%y%HubPtMotion%Position(:,1) - Init%InData_AD%rotors(1)%HubOrientation = ED%y%HubPtMotion%RefOrientation(:,:,1) - Init%InData_AD%rotors(1)%NacellePosition = ED%y%NacelleMotion%Position(:,1) - Init%InData_AD%rotors(1)%NacelleOrientation = ED%y%NacelleMotion%RefOrientation(:,:,1) + Init%InData_AD%rotors(1)%HubPosition = ED%y(iED)%HubPtMotion%Position(:,1) + Init%InData_AD%rotors(1)%HubOrientation = ED%y(iED)%HubPtMotion%RefOrientation(:,:,1) + Init%InData_AD%rotors(1)%NacellePosition = ED%y(iED)%NacelleMotion%Position(:,1) + Init%InData_AD%rotors(1)%NacelleOrientation = ED%y(iED)%NacelleMotion%RefOrientation(:,:,1) do k=1,NumBl - Init%InData_AD%rotors(1)%BladeRootPosition(:,k) = ED%y%BladeRootMotion(k)%Position(:,1) - Init%InData_AD%rotors(1)%BladeRootOrientation(:,:,k) = ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) + Init%InData_AD%rotors(1)%BladeRootPosition(:,k) = ED%y(iED)%BladeRootMotion(k)%Position(:,1) + Init%InData_AD%rotors(1)%BladeRootOrientation(:,:,k) = ED%y(iED)%BladeRootMotion(k)%RefOrientation(:,:,1) end do endif @@ -745,51 +667,51 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S ! Set pointers to flowfield IF (p_FAST%CompInflow == Module_IfW) Init%InData_AD%FlowField => Init%OutData_IfW%FlowField + ! Call module initialization subroutine 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) + if (Failed()) return - p_FAST%ModuleInitialized(Module_AD) = .TRUE. - CALL SetModuleSubstepTime(Module_AD, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + IF ( p_FAST%MHK .NE. 0_IntKi .AND. p_FAST%CompSeaSt == Module_SeaSt) THEN ! MHK turbine + ! Set AD pointers to wavefield + AD%p%WaveField => Init%OutData_SeaSt%WaveField + END IF - allocate( y_FAST%Lin%Modules(MODULE_AD)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(AD).", ErrStat, ErrMsg, RoutineName ) - else - if (allocated(Init%OutData_AD%rotors(1)%LinNames_u )) call move_alloc(Init%OutData_AD%rotors(1)%LinNames_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_u ) - if (allocated(Init%OutData_AD%rotors(1)%LinNames_y )) call move_alloc(Init%OutData_AD%rotors(1)%LinNames_y ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_y ) - if (allocated(Init%OutData_AD%rotors(1)%LinNames_x )) call move_alloc(Init%OutData_AD%rotors(1)%LinNames_x ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_x ) - if (allocated(Init%OutData_AD%rotors(1)%RotFrame_u )) call move_alloc(Init%OutData_AD%rotors(1)%RotFrame_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_u ) - if (allocated(Init%OutData_AD%rotors(1)%RotFrame_y )) call move_alloc(Init%OutData_AD%rotors(1)%RotFrame_y ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_y ) - if (allocated(Init%OutData_AD%rotors(1)%RotFrame_x )) call move_alloc(Init%OutData_AD%rotors(1)%RotFrame_x ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_x ) - if (allocated(Init%OutData_AD%rotors(1)%IsLoad_u )) call move_alloc(Init%OutData_AD%rotors(1)%IsLoad_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%IsLoad_u ) - if (allocated(Init%OutData_AD%rotors(1)%DerivOrder_x)) call move_alloc(Init%OutData_AD%rotors(1)%DerivOrder_x,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%DerivOrder_x ) - - if (allocated(Init%OutData_AD%rotors(1)%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%NumOutputs = size(Init%OutData_AD%rotors(1)%WriteOutputHdr) - end if + p_FAST%ModuleInitialized(Module_AD) = .TRUE. - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + ! Loop through rotors and add module for each one + do i = 1, size(Init%OutData_AD%rotors) + CALL MV_AddModule(m_Glue%ModData, Module_AD, 'AD', i, p_FAST%dt_module(Module_AD), p_FAST%DT, & + Init%OutData_AD%rotors(i)%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) + if (Failed()) return + end do - ! AeroDyn may override the AirDens value. Store this to inform other modules AirDens = Init%OutData_AD%rotors(1)%AirDens - ELSEIF ( p_FAST%CompAero == Module_ADsk ) THEN + case (Module_ADsk) + + ! Allocate module data arrays + allocate(ADsk%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("ADsk%Input")) return + allocate(ADsk%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("ADsk%InputTimes")) return + allocate(ADsk%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ADsk%x")) return + allocate(ADsk%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ADsk%xd")) return + allocate(ADsk%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ADsk%z")) return + allocate(ADsk%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ADsk%OtherSt")) return + Init%InData_ADsk%InputFile = p_FAST%AeroFile Init%InData_ADsk%RootName = p_FAST%OutFileRoot ! NOTE: cone angle is not included in the RotorRad calculation!!! + if (p_FAST%CompElast == Module_SED) then Init%InData_ADsk%RotorRad = Init%OutData_SED%HubRad + Init%OutData_SED%BladeLength Init%InData_ADsk%HubPosition = SED%y%HubPtMotion%Position(:,1) Init%InData_ADsk%HubOrientation = SED%y%HubPtMotion%RefOrientation(:,:,1) else - Init%InData_ADsk%RotorRad = Init%OutData_ED%HubRad + Init%OutData_ED%BladeLength - Init%InData_ADsk%HubPosition = ED%y%HubPtMotion%Position(:,1) - Init%InData_ADsk%HubOrientation = ED%y%HubPtMotion%RefOrientation(:,:,1) + Init%InData_ADsk%RotorRad = Init%OutData_ED(iED)%HubRad + Init%OutData_ED(iED)%BladeLength + Init%InData_ADsk%HubPosition = ED%y(iED)%HubPtMotion%Position(:,1) + Init%InData_ADsk%HubOrientation = ED%y(iED)%HubPtMotion%RefOrientation(:,:,1) endif + Init%InData_ADsk%defAirDens = p_FAST%AirDens Init%InData_ADsk%Linearize = p_FAST%Linearize ! NOTE: This module cannot be linearized Init%InData_ADsk%UseInputFile = .true. @@ -798,43 +720,43 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S CALL ADsk_Init( Init%InData_ADsk, ADsk%Input(1), ADsk%p, ADsk%x(STATE_CURR), ADsk%xd(STATE_CURR), ADsk%z(STATE_CURR), & ADsk%OtherSt(STATE_CURR), ADsk%y, ADsk%m, p_FAST%dt_module( MODULE_ADsk ), Init%OutData_ADsk, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return p_FAST%ModuleInitialized(Module_ADsk) = .TRUE. - CALL SetModuleSubstepTime(Module_ADsk, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! Add module to array, return on error + call MV_AddModule(m_Glue%ModData, Module_ADsk, 'ADsk', 1, p_FAST%dt_module(Module_ADsk), p_FAST%DT, & + Init%OutData_ADsk%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) + if (Failed()) return ! AeroDisk may override the AirDens value. Store this to inform other modules AirDens = Init%OutData_ADsk%AirDens - END IF ! CompAero + end select ! CompAero - IF ( p_FAST%CompAero == Module_ExtLd ) THEN + !---------------------------------------------------------------------------- + ! External Loads + !---------------------------------------------------------------------------- - IF ( PRESENT(ExternInitData) ) THEN + IF ( (p_FAST%CompAero == Module_ExtLd) .and. PRESENT(ExternInitData) ) THEN - ! set initialization data for ExtLoads - CALL ExtLd_SetInitInput(Init%InData_ExtLd, Init%OutData_ED, ED%y, Init%OutData_BD, BD%y(:), Init%OutData_AD, p_FAST, ExternInitData, ErrStat2, ErrMsg2) - CALL ExtLd_Init( Init%InData_ExtLd, ExtLd%u, ExtLd%xd(1), ExtLd%p, ExtLd%y, ExtLd%m, p_FAST%dt_module( MODULE_ExtLd ), Init%OutData_ExtLd, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! set initialization data for ExtLoads + CALL ExtLd_SetInitInput(Init%InData_ExtLd, Init%OutData_ED(iED), ED%y(iED), Init%OutData_BD, BD%y(:), Init%OutData_AD, p_FAST, ExternInitData, ErrStat2, ErrMsg2) + CALL ExtLd_Init( Init%InData_ExtLd, ExtLd%u, ExtLd%xd(1), ExtLd%p, ExtLd%y, ExtLd%m, p_FAST%dt_module( MODULE_ExtLd ), Init%OutData_ExtLd, ErrStat2, ErrMsg2 ) + if (Failed()) return - p_FAST%ModuleInitialized(Module_ExtLd) = .TRUE. - CALL SetModuleSubstepTime(Module_ExtLd, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + p_FAST%ModuleInitialized(Module_ExtLd) = .TRUE. - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + ! Add module to list of modules, return on error + CALL MV_AddModule(m_Glue%ModData, Module_ExtLd, 'ExtLd', 1, p_FAST%dt_module(Module_ExtLd), p_FAST%DT, & + Init%OutData_ExtLd%Vars, .false., ErrStat2, ErrMsg2) + if (Failed()) return ! ExtLd may override the AirDens value. Store this to inform other modules AirDens = Init%OutData_ExtLd%AirDens - END IF - END IF - ! ........................ ! No aero of any sort ! ........................ IF ( (p_FAST%CompAero == Module_None) .or. (p_FAST%CompAero == Module_Unknown)) THEN @@ -894,48 +816,37 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S endif - ! ........................ - ! initialize SuperController - ! ........................ - IF ( PRESENT(ExternInitData) ) THEN - ! set up the data structures for integration with supercontroller - IF ( p_FAST%UseSC ) THEN - CALL SC_DX_Init( ExternInitData%NumSC2CtrlGlob, ExternInitData%NumSC2Ctrl, ExternInitData%NumCtrl2SC, SC_DX, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSE + !---------------------------------------------------------------------------- + ! Initialize SuperController + !---------------------------------------------------------------------------- + + if (present(ExternInitData)) then + if (p_FAST%UseSC) then + call SC_DX_Init(ExternInitData%NumSC2CtrlGlob, ExternInitData%NumSC2Ctrl, ExternInitData%NumCtrl2SC, SC_DX, ErrStat2, ErrMsg2) + if (Failed()) return + else SC_DX%u%c_obj%toSC_Len = 0 SC_DX%u%c_obj%toSC = C_NULL_PTR SC_DX%y%c_obj%fromSC_Len = 0 SC_DX%y%c_obj%fromSC = C_NULL_PTR SC_DX%y%c_obj%fromSCglob_Len = 0 SC_DX%y%c_obj%fromSCglob = C_NULL_PTR - END IF - END IF + end if + end if - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + !---------------------------------------------------------------------------- + ! CompHydro (HydroDyn) + !---------------------------------------------------------------------------- + ! Allocate module data arrays + allocate(HD%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("HD%Input")) return + allocate(HD%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("HD%InputTimes")) return + allocate(HD%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("HD%x")) return + allocate(HD%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("HD%xd")) return + allocate(HD%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("HD%z")) return + allocate(HD%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("HD%OtherSt")) return - ! ........................ - ! initialize HydroDyn - ! ........................ - ALLOCATE( HD%Input( p_FAST%InterpOrder+1 ), HD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating HD%Input and HD%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ALLOCATE( HD%Input_Saved( p_FAST%InterpOrder+1 ), HD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating HD%Input_Saved and HD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - IF ( p_FAST%CompHydro == Module_HD ) THEN + IF (p_FAST%CompHydro == Module_HD) THEN Init%InData_HD%Gravity = p_FAST%Gravity Init%InData_HD%UseInputFile = .TRUE. @@ -943,7 +854,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S Init%InData_HD%OutRootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_HD)) Init%InData_HD%TMax = p_FAST%TMax Init%InData_HD%Linearize = p_FAST%Linearize - Init%InData_HD%PlatformPos = Init%OutData_ED%PlatformPos ! Initial platform position; PlatformPos(1:3) is effectively the initial position of the HD origin + Init%InData_HD%PlatformPos = Init%OutData_ED(iED)%PlatformPos ! Initial platform position; PlatformPos(1:3) is effectively the initial position of the HD origin if (p_FAST%WrVTK /= VTK_None) Init%InData_HD%VisMeshes=.true. ! if ( p_FAST%CompSeaSt == Module_SeaSt ) then ! this is always true @@ -951,263 +862,162 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S Init%InData_HD%WaveField => Init%OutData_SeaSt%WaveField ! end if - - 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) + ! Call module initialization routine + 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) + if (Failed()) return p_FAST%ModuleInitialized(Module_HD) = .TRUE. - CALL SetModuleSubstepTime(Module_HD, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - allocate( y_FAST%Lin%Modules(MODULE_HD)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(HD).", ErrStat, ErrMsg, RoutineName ) - else - 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 ) - 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(Init%OutData_HD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%NumOutputs = size(Init%OutData_HD%WriteOutputHdr) - end if + CALL MV_AddModule(m_Glue%ModData, Module_HD, 'HD', 1, p_FAST%dt_module(Module_HD), p_FAST%DT, & + Init%OutData_HD%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) + if (Failed()) return - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF END IF ! CompHydro - ! ........................ - ! initialize SubDyn or ExtPtfm_MCKF - ! ........................ - ALLOCATE( SD%Input( p_FAST%InterpOrder+1 ), SD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating SD%Input and SD%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ALLOCATE( SD%Input_Saved( p_FAST%InterpOrder+1 ), SD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating SD%Input_Saved and SD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ALLOCATE( ExtPtfm%Input( p_FAST%InterpOrder+1 ), ExtPtfm%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating ExtPtfm%Input and ExtPtfm%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ALLOCATE( ExtPtfm%Input_Saved( p_FAST%InterpOrder+1 ), ExtPtfm%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating ExtPtfm%Input_Saved and ExtPtfm%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - IF ( p_FAST%CompSub == Module_SD ) THEN - - IF ( p_FAST%CompHydro == Module_HD ) THEN + !---------------------------------------------------------------------------- + ! CompSub (SubDyn or ExtPtfm) + !---------------------------------------------------------------------------- + + ! Allocate module data arrays + allocate(SD%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("SD%Input")) return + allocate(SD%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("SD%InputTimes")) return + allocate(SD%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SD%x")) return + allocate(SD%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SD%xd")) return + allocate(SD%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SD%z")) return + allocate(SD%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SD%OtherSt")) return + + ! Allocate module data arrays + allocate(ExtPtfm%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("ExtPtfm%Input")) return + allocate(ExtPtfm%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%InputTimes")) return + allocate(ExtPtfm%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%x")) return + allocate(ExtPtfm%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%xd")) return + allocate(ExtPtfm%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%z")) return + allocate(ExtPtfm%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ExtPtfm%OtherSt")) return + + select case (p_FAST%CompSub) + + case (Module_SD) + + Init%InData_SD%WtrDpth = 0.0_ReKi + if (p_FAST%CompHydro == Module_HD) then Init%InData_SD%WtrDpth = Init%OutData_SeaSt%WaveField%WtrDpth - ELSE - Init%InData_SD%WtrDpth = 0.0_ReKi - END IF + end if Init%InData_SD%Linearize = p_FAST%Linearize Init%InData_SD%g = p_FAST%Gravity - !Ini%tInData_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) ! "Interface point" where loads will be transferred to - Init%InData_SD%SubRotateZ = 0.0 ! Used by driver to rotate structure around z - + Init%InData_SD%TP_RefPoint = ED%y(iED)%PlatformPtMesh%Position(:,1) ! "Interface point" where loads will be transferred to + Init%InData_SD%SubRotateZ = 0.0 ! Used by driver to rotate structure around z 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) + if (Failed()) return p_FAST%ModuleInitialized(Module_SD) = .TRUE. - CALL SetModuleSubstepTime(Module_SD, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - allocate( y_FAST%Lin%Modules(MODULE_SD)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(SD).", ErrStat, ErrMsg, RoutineName ) - else - if (allocated(Init%OutData_SD%LinNames_y)) call move_alloc(Init%OutData_SD%LinNames_y,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%Names_y) - if (allocated(Init%OutData_SD%LinNames_x)) call move_alloc(Init%OutData_SD%LinNames_x,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%Names_x) - if (allocated(Init%OutData_SD%LinNames_u)) call move_alloc(Init%OutData_SD%LinNames_u,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%Names_u) - if (allocated(Init%OutData_SD%RotFrame_y)) call move_alloc(Init%OutData_SD%RotFrame_y,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%RotFrame_y) - if (allocated(Init%OutData_SD%RotFrame_x)) call move_alloc(Init%OutData_SD%RotFrame_x,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%RotFrame_x) - if (allocated(Init%OutData_SD%RotFrame_u)) call move_alloc(Init%OutData_SD%RotFrame_u,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%RotFrame_u) - if (allocated(Init%OutData_SD%IsLoad_u )) call move_alloc(Init%OutData_SD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%IsLoad_u ) - if (allocated(Init%OutData_SD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%NumOutputs = size(Init%OutData_SD%WriteOutputHdr) - if (allocated(Init%OutData_SD%DerivOrder_x)) call move_alloc(Init%OutData_SD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%DerivOrder_x) - end if + CALL MV_AddModule(m_Glue%ModData, Module_SD, 'SD', 1, p_FAST%dt_module(Module_SD), p_FAST%DT, & + Init%OutData_SD%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) + if (Failed()) return - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + + case (Module_ExtPtfm) 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%RootName = trim(p_FAST%OutFileRoot)//'.'//y_FAST%Module_Abrev(Module_ExtPtfm) Init%InData_ExtPtfm%Linearize = p_FAST%Linearize - Init%InData_ExtPtfm%PtfmRefzt = ED%p%PtfmRefzt ! Required + Init%InData_ExtPtfm%PtfmRefzt = ED%p(iED)%PtfmRefzt ! Required - 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 ), Init%OutData_ExtPtfm, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + 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), Init%OutData_ExtPtfm, ErrStat2, ErrMsg2) + if (Failed()) return p_FAST%ModuleInitialized(MODULE_ExtPtfm) = .TRUE. - CALL SetModuleSubstepTime(MODULE_ExtPtfm, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - allocate( y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(ExtPtfm).", ErrStat, ErrMsg, RoutineName ) - else - 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) - if (allocated(Init%OutData_ExtPtfm%DerivOrder_x)) call move_alloc(Init%OutData_ExtPtfm%DerivOrder_x,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%DerivOrder_x) - end if - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + + CALL MV_AddModule(m_Glue%ModData, MODULE_ExtPtfm, 'ExtPtfm', 1, p_FAST%dt_module(MODULE_ExtPtfm), p_FAST%DT, & + Init%OutData_ExtPtfm%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) + if (Failed()) return - END IF + end select - ! ------------------------------ - ! initialize CompMooring modules - ! ------------------------------ - ALLOCATE( MAPp%Input( p_FAST%InterpOrder+1 ), MAPp%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating MAPp%Input and MAPp%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - ALLOCATE( MAPp%Input_Saved( p_FAST%InterpOrder+1 ), MAPp%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating MAPp%Input_Saved and MAPp%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - ALLOCATE( MD%Input( p_FAST%InterpOrder+1 ), MD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating MD%Input and MD%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - ALLOCATE( MD%Input_Saved( p_FAST%InterpOrder+1 ), MD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating MD%Input_Saved and MD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - ALLOCATE( FEAM%Input( p_FAST%InterpOrder+1 ), FEAM%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating FEAM%Input and FEAM%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - ALLOCATE( FEAM%Input_Saved( p_FAST%InterpOrder+1 ), FEAM%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating FEAM%Input_Saved and FEAM%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - ALLOCATE( Orca%Input( p_FAST%InterpOrder+1 ), Orca%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating Orca%Input and Orca%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - ALLOCATE( Orca%Input_Saved( p_FAST%InterpOrder+1 ), Orca%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating Orca%Input_Saved and Orca%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + !---------------------------------------------------------------------------- + ! CompMooring + !---------------------------------------------------------------------------- + + ! Allocate module data arrays + allocate(MAPp%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("MAPp%Input")) return + allocate(MAPp%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("MAPp%InputTimes")) return + allocate(MAPp%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MAPp%x")) return + allocate(MAPp%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MAPp%xd")) return + allocate(MAPp%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MAPp%z")) return + + ! Allocate module data arrays + allocate(MD%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("MD%Input")) return + allocate(MD%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("MD%InputTimes")) return + allocate(MD%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MD%x")) return + allocate(MD%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MD%xd")) return + allocate(MD%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MD%z")) return + allocate(MD%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("MD%OtherSt")) return + + ! Allocate module data arrays + allocate(FEAM%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("FEAM%Input")) return + allocate(FEAM%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("FEAM%InputTimes")) return + allocate(FEAM%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("FEAM%x")) return + allocate(FEAM%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("FEAM%xd")) return + allocate(FEAM%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("FEAM%z")) return + allocate(FEAM%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("FEAM%OtherSt")) return + + ! Allocate module data arrays + allocate(Orca%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("Orca%Input")) return + allocate(Orca%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("Orca%InputTimes")) return + allocate(Orca%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("Orca%x")) return + allocate(Orca%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("Orca%xd")) return + allocate(Orca%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("Orca%z")) return + allocate(Orca%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("Orca%OtherSt")) return + + + select case (p_FAST%CompMooring) + + case (Module_MAP) - ! ........................ - ! initialize MAP - ! ........................ - IF (p_FAST%CompMooring == Module_MAP) THEN !bjj: until we modify this, MAP requires HydroDyn to be used. (perhaps we could send air density from AeroDyn or something...) CALL WrScr(NewLine) !bjj: I'm printing two blank lines here because MAP seems to be writing over the last line on the screen. -! Init%InData_MAP%rootname = p_FAST%OutFileRoot ! Output file name - Init%InData_MAP%gravity = p_FAST%Gravity ! This need to be according to g from driver + ! Init%InData_MAP%rootname = p_FAST%OutFileRoot ! Output file name + Init%InData_MAP%gravity = p_FAST%Gravity ! This need to be according to g from driver Init%InData_MAP%sea_density = Init%OutData_SeaSt%WaveField%WtrDens ! This needs to be set according to seawater density in SeaState - ! differences for MAP++ + ! differences for MAP++ 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_SeaSt%WaveField%WtrDpth ! This need to be set according to the water depth in SeaState - Init%InData_MAP%LinInitInp%Linearize = p_FAST%Linearize + Init%InData_MAP%Linearize = p_FAST%Linearize - 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) + 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, MAPp%m, p_FAST%dt_module(MODULE_MAP), Init%OutData_MAP, ErrStat2, ErrMsg2) + if (Failed()) return p_FAST%ModuleInitialized(Module_MAP) = .TRUE. - CALL SetModuleSubstepTime(Module_MAP, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - allocate( y_FAST%Lin%Modules(Module_MAP)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(MAP).", ErrStat, ErrMsg, RoutineName ) - else - 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 ) - 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(Init%OutData_MAP%WriteOutputHdr)) y_FAST%Lin%Modules(Module_MAP)%Instance(1)%NumOutputs = size(Init%OutData_MAP%WriteOutputHdr) - end if + CALL MV_AddModule(m_Glue%ModData, Module_MAP, 'MAP', 1, p_FAST%dt_module(Module_MAP), p_FAST%DT, & + Init%OutData_MAP%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) + if (Failed()) return - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - ! ........................ - ! initialize MoorDyn - ! ........................ - ELSEIF (p_FAST%CompMooring == Module_MD) THEN + case (Module_MD) ! some new allocations needed with version that's compatible with farm-level use - ALLOCATE( Init%InData_MD%PtfmInit(6,1), Init%InData_MD%TurbineRefPos(3,1), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating MoorDyn PtfmInit and TurbineRefPos initialization inputs.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + allocate(Init%InData_MD%PtfmInit (6,1), stat=ErrStat2); if (FailedAlloc("Init%InData_MD%PtfmInit")) return + allocate(Init%InData_MD%TurbineRefPos(3,1), stat=ErrStat2); if (FailedAlloc("Init%InData_MD%TurbineRefPos")) return 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 - Init%InData_MD%PtfmInit(:,1) = Init%OutData_ED%PlatformPos ! initial position of the platform (when a FAST module, MoorDyn just takes one row in this matrix) + Init%InData_MD%PtfmInit(:,1) = Init%OutData_ED(iED)%PlatformPos ! initial position of the platform (when a FAST module, MoorDyn just takes one row in this matrix) Init%InData_MD%FarmSize = 0 ! 0 here indicates normal FAST module use of MoorDyn, for a single turbine Init%InData_MD%TurbineRefPos(:,1) = 0.0_DbKi ! for normal FAST use, the global reference frame is at 0,0,0 Init%InData_MD%g = p_FAST%Gravity ! This need to be according to g used in ElastoDyn @@ -1216,65 +1026,42 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S Init%InData_MD%Tmax = p_FAST%TMax ! expected simulation duration (used by MoorDyn for wave kinematics preprocesing) Init%InData_MD%Linearize = p_FAST%Linearize - if (p_FAST%WrVTK /= VTK_None) Init%InData_MD%VisMeshes=.true. + if (p_FAST%WrVTK /= VTK_None) Init%InData_MD%VisMeshes = .true. 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) + if (Failed()) return p_FAST%ModuleInitialized(Module_MD) = .TRUE. - CALL SetModuleSubstepTime(Module_MD, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - allocate( y_FAST%Lin%Modules(MODULE_MD)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(MD).", ErrStat, ErrMsg, RoutineName ) - else - if (allocated(Init%OutData_MD%LinNames_y)) call move_alloc(Init%OutData_MD%LinNames_y,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%Names_y) - if (allocated(Init%OutData_MD%LinNames_x)) call move_alloc(Init%OutData_MD%LinNames_x,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%Names_x) - if (allocated(Init%OutData_MD%LinNames_u)) call move_alloc(Init%OutData_MD%LinNames_u,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%Names_u) - if (allocated(Init%OutData_MD%RotFrame_y)) call move_alloc(Init%OutData_MD%RotFrame_y,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%RotFrame_y) - if (allocated(Init%OutData_MD%RotFrame_x)) call move_alloc(Init%OutData_MD%RotFrame_x,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%RotFrame_x) - if (allocated(Init%OutData_MD%RotFrame_u)) call move_alloc(Init%OutData_MD%RotFrame_u,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%RotFrame_u) - if (allocated(Init%OutData_MD%IsLoad_u )) call move_alloc(Init%OutData_MD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%IsLoad_u ) - if (allocated(Init%OutData_MD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%NumOutputs = size(Init%OutData_MD%WriteOutputHdr) - if (allocated(Init%OutData_MD%DerivOrder_x)) call move_alloc(Init%OutData_MD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%DerivOrder_x) - end if + CALL MV_AddModule(m_Glue%ModData, Module_MD, 'MD', 1, p_FAST%dt_module(Module_MD), p_FAST%DT, & + Init%OutData_MD%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) + if (Failed()) return - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - ! ........................ - ! initialize FEAM - ! ........................ - ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + case (Module_FEAM) 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 = p_FAST%Gravity ! This need to be according to g from driver - Init%InData_FEAM%WtrDens = Init%OutData_SeaSt%WaveField%WtrDens ! This needs to be set according to seawater density in SeaState -! Init%InData_FEAM%depth = Init%OutData_SeaSt%WaveField%WtrDpth ! This need to be set according to the water depth in SeaState + Init%InData_FEAM%PtfmInit = Init%OutData_ED(iED)%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 = p_FAST%Gravity ! This need to be according to g from driver + Init%InData_FEAM%WtrDens = Init%OutData_SeaSt%WaveField%WtrDens ! This needs to be set according to seawater density in SeaState + ! Init%InData_FEAM%depth = Init%OutData_SeaSt%WaveField%WtrDpth ! This need to be set according to the water depth in SeaState - 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) + 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) + if (Failed()) return p_FAST%ModuleInitialized(Module_FEAM) = .TRUE. - CALL SetModuleSubstepTime(Module_FEAM, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - ! ........................ - ! initialize OrcaFlex Interface - ! ........................ - ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + CALL MV_AddModule(m_Glue%ModData, Module_FEAM, 'FEAM', 1, p_FAST%dt_module(Module_FEAM), p_FAST%DT, & + Init%OutData_FEAM%Vars, .false., ErrStat2, ErrMsg2) + if (Failed()) return + + case (Module_Orca) Init%InData_Orca%InputFile = p_FAST%MooringFile Init%InData_Orca%RootName = p_FAST%OutFileRoot @@ -1282,79 +1069,33 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S 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) + if (Failed()) return p_FAST%ModuleInitialized(MODULE_Orca) = .TRUE. - CALL SetModuleSubstepTime(MODULE_Orca, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - END IF - - ! ------------------------------ - ! initialize CompIce modules - ! ------------------------------ - ALLOCATE( IceF%Input( p_FAST%InterpOrder+1 ), IceF%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating IceF%Input and IceF%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - ALLOCATE( IceF%Input_Saved( p_FAST%InterpOrder+1 ), IceF%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating IceF%Input_Saved and IceF%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + CALL MV_AddModule(m_Glue%ModData, Module_Orca, 'Orca', 1, p_FAST%dt_module(Module_Orca), p_FAST%DT, & + Init%OutData_Orca%Vars, .false., ErrStat2, ErrMsg2) + if (Failed()) return - ! We need this to be allocated (else we have issues passing nonallocated arrays and using the first index of Input(), - ! but we don't need the space of IceD_MaxLegs if we're not using it. - IF ( p_FAST%CompIce /= Module_IceD ) THEN - IceDim = 1 - ELSE - IceDim = IceD_MaxLegs - END IF - - ! because there may be multiple instances of IceDyn, we'll allocate arrays for that here - ! we could allocate these after - ALLOCATE( IceD%Input( p_FAST%InterpOrder+1, IceDim ), IceD%InputTimes( p_FAST%InterpOrder+1, IceDim ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating IceD%Input and IceD%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + END select - ALLOCATE( IceD%Input_Saved( p_FAST%InterpOrder+1, IceDim ), IceD%InputTimes_Saved( p_FAST%InterpOrder+1, IceDim ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating IceD%Input_Saved and IceD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + !---------------------------------------------------------------------------- + ! CompIce (IceD and IceF) + !---------------------------------------------------------------------------- - ALLOCATE( IceD%x( IceDim,4), & - IceD%xd( IceDim,4), & - IceD%z( IceDim,4), & - IceD%OtherSt( IceDim,4), & - IceD%p( IceDim ), & - IceD%u( IceDim ), & - IceD%y( IceDim ), & - IceD%m( IceDim ), & - STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating IceD state, input, and output data.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + !------------------------------------- + ! Initialize IceFloe + !------------------------------------- + ! Allocate module data arrays + allocate(IceF%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("IceF%Input")) return + allocate(IceF%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("IceF%InputTimes")) return + allocate(IceF%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IceF%x")) return + allocate(IceF%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IceF%xd")) return + allocate(IceF%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IceF%z")) return + allocate(IceF%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("IceF%OtherSt")) return - ! ........................ - ! initialize IceFloe - ! ........................ - IF ( p_FAST%CompIce == Module_IceF ) THEN + IF (p_FAST%CompIce == Module_IceF) THEN Init%InData_IceF%InputFile = p_FAST%IceFile Init%InData_IceF%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceF)) @@ -1364,20 +1105,38 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S 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) - + if (Failed()) return + p_FAST%ModuleInitialized(Module_IceF) = .TRUE. - CALL SetModuleSubstepTime(Module_IceF, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - ! ........................ - ! initialize IceDyn - ! ........................ - ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + ! Add module to list of modules + CALL MV_AddModule(m_Glue%ModData, Module_IceF, 'IceF', 1, p_FAST%dt_module(Module_IceF), p_FAST%DT, & + Init%OutData_IceF%Vars, .false., ErrStat2, ErrMsg2) + if (Failed()) return + + end if + + !------------------------------------- + ! Initialize IceDyn + !------------------------------------- + + ! We need this to be allocated (else we have issues passing nonallocated arrays and using the first index of Input(), + ! but we don't need the space of IceD_MaxLegs if we're not using it. + IceDim = 1 + IF (p_FAST%CompIce == Module_IceD) IceDim = IceD_MaxLegs + + ! Allocate module data arrays + allocate(IceD%Input (InputAryLB:InputAryUB, IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%Input")) return + allocate(IceD%InputTimes (InputAryUB, IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%InputTimes")) return + allocate(IceD%x (IceDim, StateAryUB), stat=ErrStat2); if (FailedAlloc("IceD%x")) return + allocate(IceD%xd (IceDim, StateAryUB), stat=ErrStat2); if (FailedAlloc("IceD%xd")) return + allocate(IceD%z (IceDim, StateAryUB), stat=ErrStat2); if (FailedAlloc("IceD%z")) return + allocate(IceD%OtherSt (IceDim, StateAryUB), stat=ErrStat2); if (FailedAlloc("IceD%OtherSt")) return + allocate(IceD%p (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%p")) return + allocate(IceD%y (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%y")) return + allocate(IceD%m (IceDim ), stat=ErrStat2); if (FailedAlloc("IceD%m")) return + + IF (p_FAST%CompIce == Module_IceD) THEN Init%InData_IceD%InputFile = p_FAST%IceFile Init%InData_IceD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceD))//'1' @@ -1389,14 +1148,17 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S 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) + if (Failed()) return p_FAST%ModuleInitialized(Module_IceD) = .TRUE. - CALL SetModuleSubstepTime(Module_IceD, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! now initialize IceD for additional legs (if necessary) - dt_IceD = p_FAST%dt_module( MODULE_IceD ) + ! Add module to list of modules + CALL MV_AddModule(m_Glue%ModData, Module_IceD, 'IceD', 1, p_FAST%dt_module(Module_IceD), p_FAST%DT, & + Init%OutData_IceD%Vars, .false., ErrStat2, ErrMsg2) + if (Failed()) return + + ! now initialize IceD for additional legs (if necessary) + dt_IceD = p_FAST%dt_module(MODULE_IceD) p_FAST%numIceLegs = Init%OutData_IceD%numLegs IF (p_FAST%numIceLegs > IceD_MaxLegs) THEN @@ -1404,58 +1166,51 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S //TRIM(Num2LStr(p_FAST%numIceLegs))//' legs were specified.',ErrStat,ErrMsg,RoutineName) END IF - + ! Loop through Icelegs 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 + 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( 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) + if (Failed()) return !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. - IF (.NOT. EqualRealNos( p_FAST%dt_module( MODULE_IceD ),dt_IceD )) THEN + IF (.NOT. EqualRealNos( p_FAST%dt_module(MODULE_IceD),dt_IceD )) THEN CALL SetErrStat(ErrID_Fatal,"All instances of IceDyn (one per support-structure leg) must be the same",ErrStat,ErrMsg,RoutineName) + return END IF - END DO - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + ! Add module to list of modules + CALL MV_AddModule(m_Glue%ModData, Module_IceD, 'IceD', i, p_FAST%dt_module(Module_IceD), p_FAST%DT, & + Init%OutData_IceD%Vars, .false., ErrStat2, ErrMsg2) + if (Failed()) return + END DO END IF + !---------------------------------------------------------------------------- + ! CompServo (ServoDyn) + !---------------------------------------------------------------------------- - ! ........................ - ! initialize ServoDyn - ! ........................ - ALLOCATE( SrvD%Input( p_FAST%InterpOrder+1 ), SrvD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating SrvD%Input and SrvD%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ALLOCATE( SrvD%Input_Saved( p_FAST%InterpOrder+1 ), SrvD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating SrvD%Input_Saved and SrvD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + ! Allocate module data arrays + allocate(SrvD%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("SrvD%Input")) return + allocate(SrvD%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("SrvD%InputTimes")) return + allocate(SrvD%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SrvD%x")) return + allocate(SrvD%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SrvD%xd")) return + allocate(SrvD%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SrvD%z")) return + allocate(SrvD%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SrvD%OtherSt")) return IF ( p_FAST%CompServo == Module_SrvD ) THEN + 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 = NumBl Init%InData_SrvD%Gravity = (/ 0.0_ReKi, 0.0_ReKi, -p_FAST%Gravity /) ! "Gravitational acceleration vector" m/s^2 CALL AllocAry(Init%InData_SrvD%BlPitchInit, NumBl, 'BlPitchInit', ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= abortErrLev) then ! make sure allocatable arrays are valid before setting them - CALL Cleanup() - RETURN - end if + if (Failed()) return if (p_FAST%CompElast == Module_SED) then Init%InData_SrvD%NacRefPos(1:3) = SED%y%NacelleMotion%Position(1:3,1) @@ -1473,20 +1228,20 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S Init%InData_SrvD%RotSpeedRef = Init%OutData_SED%RotSpeed Init%InData_SrvD%BlPitchInit = Init%OutData_SED%BlPitch else - Init%InData_SrvD%NacRefPos(1:3) = ED%y%NacelleMotion%Position(1:3,1) - Init%InData_SrvD%NacTransDisp(1:3) = ED%y%NacelleMotion%TranslationDisp(1:3,1) ! R8Ki - Init%InData_SrvD%NacRefOrient(1:3,1:3) = ED%y%NacelleMotion%RefOrientation(1:3,1:3,1) ! R8Ki - Init%InData_SrvD%NacOrient(1:3,1:3) = ED%y%NacelleMotion%Orientation(1:3,1:3,1) ! R8Ki - Init%InData_SrvD%TwrBaseRefPos = Init%OutData_ED%TwrBaseRefPos - Init%InData_SrvD%TwrBaseTransDisp = Init%OutData_ED%TwrBaseTransDisp ! R8Ki - Init%InData_SrvD%TwrBaseRefOrient = Init%OutData_ED%TwrBaseRefOrient ! R8Ki - Init%InData_SrvD%TwrBaseOrient = Init%OutData_ED%TwrBaseOrient ! R8Ki - Init%InData_SrvD%PtfmRefPos(1:3) = ED%y%PlatformPtMesh%Position(1:3,1) - Init%InData_SrvD%PtfmTransDisp(1:3) = ED%y%PlatformPtMesh%TranslationDisp(1:3,1) ! R8Ki - Init%InData_SrvD%PtfmRefOrient(1:3,1:3)= ED%y%PlatformPtMesh%RefOrientation(1:3,1:3,1) ! R8Ki - Init%InData_SrvD%PtfmOrient(1:3,1:3) = ED%y%PlatformPtMesh%Orientation(1:3,1:3,1) ! R8Ki - Init%InData_SrvD%RotSpeedRef = Init%OutData_ED%RotSpeed - Init%InData_SrvD%BlPitchInit = Init%OutData_ED%BlPitch + Init%InData_SrvD%NacRefPos(1:3) = ED%y(iED)%NacelleMotion%Position(1:3,1) + Init%InData_SrvD%NacTransDisp(1:3) = ED%y(iED)%NacelleMotion%TranslationDisp(1:3,1) ! R8Ki + Init%InData_SrvD%NacRefOrient(1:3,1:3) = ED%y(iED)%NacelleMotion%RefOrientation(1:3,1:3,1) ! R8Ki + Init%InData_SrvD%NacOrient(1:3,1:3) = ED%y(iED)%NacelleMotion%Orientation(1:3,1:3,1) ! R8Ki + Init%InData_SrvD%TwrBaseRefPos = Init%OutData_ED(iED)%TwrBaseRefPos + Init%InData_SrvD%TwrBaseTransDisp = Init%OutData_ED(iED)%TwrBaseTransDisp ! R8Ki + Init%InData_SrvD%TwrBaseRefOrient = Init%OutData_ED(iED)%TwrBaseRefOrient ! R8Ki + Init%InData_SrvD%TwrBaseOrient = Init%OutData_ED(iED)%TwrBaseOrient ! R8Ki + Init%InData_SrvD%PtfmRefPos(1:3) = ED%y(iED)%PlatformPtMesh%Position(1:3,1) + Init%InData_SrvD%PtfmTransDisp(1:3) = ED%y(iED)%PlatformPtMesh%TranslationDisp(1:3,1) ! R8Ki + Init%InData_SrvD%PtfmRefOrient(1:3,1:3)= ED%y(iED)%PlatformPtMesh%RefOrientation(1:3,1:3,1) ! R8Ki + Init%InData_SrvD%PtfmOrient(1:3,1:3) = ED%y(iED)%PlatformPtMesh%Orientation(1:3,1:3,1) ! R8Ki + Init%InData_SrvD%RotSpeedRef = Init%OutData_ED(iED)%RotSpeed + Init%InData_SrvD%BlPitchInit = Init%OutData_ED(iED)%BlPitch endif Init%InData_SrvD%TMax = p_FAST%TMax Init%InData_SrvD%AirDens = AirDens @@ -1496,18 +1251,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S Init%InData_SrvD%TrimGain = p_FAST%TrimGain Init%InData_SrvD%InterpOrder = p_FAST%InterpOrder - CALL AllocAry( Init%InData_SrvD%BladeRootRefPos, 3, NumBl, 'Init%InData_SrvD%BladeRootRefPos', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry( Init%InData_SrvD%BladeRootTransDisp, 3, NumBl, 'Init%InData_SrvD%BladeRootTransDisp', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry( Init%InData_SrvD%BladeRootRefOrient, 3, 3, NumBl, 'Init%InData_SrvD%BladeRootRefOrient', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry( Init%InData_SrvD%BladeRootOrient, 3, 3, NumBl, 'Init%InData_SrvD%BladeRootOrient', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + CALL AllocAry(Init%InData_SrvD%BladeRootRefPos, 3, NumBl, 'Init%InData_SrvD%BladeRootRefPos', ErrStat2, ErrMsg2); if (Failed()) return + CALL AllocAry(Init%InData_SrvD%BladeRootTransDisp, 3, NumBl, 'Init%InData_SrvD%BladeRootTransDisp', ErrStat2, ErrMsg2); if (Failed()) return + CALL AllocAry(Init%InData_SrvD%BladeRootRefOrient, 3, 3, NumBl, 'Init%InData_SrvD%BladeRootRefOrient', ErrStat2, ErrMsg2); if (Failed()) return + CALL AllocAry(Init%InData_SrvD%BladeRootOrient, 3, 3, NumBl, 'Init%InData_SrvD%BladeRootOrient', ErrStat2, ErrMsg2); if (Failed()) return + ! Set blade root info -- used for Blade StC. Set from SED even though SED is not compatible -- we won't know ! if the BStC was used until after calling SrvD_Init. if (p_FAST%CompElast == Module_SED) then @@ -1519,23 +1267,18 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S enddo else do k=1,NumBl - Init%InData_SrvD%BladeRootRefPos(:,k) = ED%y%BladeRootMotion(k)%Position(:,1) - Init%InData_SrvD%BladeRootTransDisp(:,k) = ED%y%BladeRootMotion(k)%TranslationDisp(:,1) - Init%InData_SrvD%BladeRootRefOrient(:,:,k)= ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) - Init%InData_SrvD%BladeRootOrient(:,:,k) = ED%y%BladeRootMotion(k)%Orientation(:,:,1) + Init%InData_SrvD%BladeRootRefPos(:,k) = ED%y(iED)%BladeRootMotion(k)%Position(:,1) + Init%InData_SrvD%BladeRootTransDisp(:,k) = ED%y(iED)%BladeRootMotion(k)%TranslationDisp(:,1) + Init%InData_SrvD%BladeRootRefOrient(:,:,k)= ED%y(iED)%BladeRootMotion(k)%RefOrientation(:,:,1) + Init%InData_SrvD%BladeRootOrient(:,:,k) = ED%y(iED)%BladeRootMotion(k)%Orientation(:,:,1) enddo endif - IF ( PRESENT(ExternInitData) ) THEN Init%InData_SrvD%NumSC2CtrlGlob = ExternInitData%NumSC2CtrlGlob IF ( (Init%InData_SrvD%NumSC2CtrlGlob > 0) ) THEN CALL AllocAry( Init%InData_SrvD%fromSCGlob, Init%InData_SrvD%NumSC2CtrlGlob, 'Init%InData_SrvD%fromSCGlob', ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + if (Failed()) return do i=1,Init%InData_SrvD%NumSC2CtrlGlob Init%InData_SrvD%fromSCGlob(i) = ExternInitData%fromSCGlob(i) @@ -1545,11 +1288,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S Init%InData_SrvD%NumSC2Ctrl = ExternInitData%NumSC2Ctrl IF ( (Init%InData_SrvD%NumSC2Ctrl > 0) ) THEN CALL AllocAry( Init%InData_SrvD%fromSC, Init%InData_SrvD%NumSC2Ctrl, 'Init%InData_SrvD%fromSC', ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + if (Failed()) return do i=1,Init%InData_SrvD%NumSC2Ctrl Init%InData_SrvD%fromSC(i) = ExternInitData%fromSC(i) @@ -1563,7 +1302,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S Init%InData_SrvD%NumSC2Ctrl = 0 Init%InData_SrvD%NumCtrl2SC = 0 END IF - + IF ( p_FAST%CompInflow == Module_IfW ) THEN !assign the number of gates to ServD if (allocated(IfW%y%lidar%LidSpeed)) then ! make sure we have the array allocated before setting it CALL AllocAry(Init%InData_SrvD%LidSpeed, size(IfW%y%lidar%LidSpeed), 'Init%InData_SrvD%LidSpeed', errStat2, ErrMsg2) @@ -1591,52 +1330,31 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S Init%InData_SrvD%PulseSpacing = IfW%p%lidar%PulseSpacing END IF - ! Set cable controls inputs (if requested by other modules) -- There is probably a nicer way to do this, but this will work for now. call SetSrvDCableControls() - 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) + if (Failed()) return p_FAST%ModuleInitialized(Module_SrvD) = .TRUE. !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) + ! Add module to list of modules + CALL MV_AddModule(m_Glue%ModData, Module_SrvD, 'SrvD', 1, p_FAST%dt_module(Module_SrvD), p_FAST%DT, & + Init%OutData_SrvD%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) + if (Failed()) return !! initialize SrvD%y%ElecPwr and SrvD%y%GenTq because they are one timestep different (used as input for the next step)? - allocate( y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(SrvD).", ErrStat, ErrMsg, RoutineName ) - else - 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%LinNames_x)) call move_alloc(Init%OutData_SrvD%LinNames_x,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%Names_x ) - 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%RotFrame_x)) call move_alloc(Init%OutData_SrvD%RotFrame_x,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%RotFrame_x ) - 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(Init%OutData_SrvD%DerivOrder_x)) call move_alloc(Init%OutData_SrvD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%DerivOrder_x) - - 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 - CALL Cleanup() - RETURN - END IF - - ! ........................ - ! some checks for AeroDyn and ElastoDyn inputs with the high-speed shaft brake hack in ElastoDyn: - ! (DO NOT COPY THIS CODE!) - ! ........................ - ! bjj: this is a hack to get high-speed shaft braking in FAST v8 - + ! ........................ + ! some checks for AeroDyn and ElastoDyn inputs with the high-speed shaft brake hack in ElastoDyn: + ! (DO NOT COPY THIS CODE!) + ! ........................ + + ! bjj: this is a hack to get high-speed shaft braking in FAST v8 IF ( Init%OutData_SrvD%UseHSSBrake ) THEN - IF ( ED%p%method == Method_RK4 ) THEN ! bjj: should be using ElastoDyn's Method_ABM4 Method_AB4 parameters + IF ( ED%p(iED)%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 ! Init%OutData_SrvD%UseHSSBrake @@ -1651,80 +1369,35 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S END IF + !---------------------------------------------------------------------------- + ! Set up output for glue code + ! (must be done after all modules are initialized so we have their WriteOutput information) + !---------------------------------------------------------------------------- - ! ........................ - ! 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, Init, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! ------------------------------------------------------------------------- - ! Initialize mesh-mapping data - ! ------------------------------------------------------------------------- - - CALL InitModuleMappings(p_FAST, ED, SED, BD, AD, ADsk, ExtLd, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - 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 or computing aero maps: - ! ------------------------------------------------------------------------- - if ( p_FAST%Linearize .or. p_FAST%CompAeroMaps) then - ! NOTE: In the following call, we use Init%OutData_AD%BladeProps(1)%NumBlNds as the number of aero nodes on EACH blade, which - ! is consistent with the current AD implementation, but if AD changes this, then it must be handled here, too! - if (p_FAST%CompAero == MODULE_AD) then - call Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds, ErrStat2, ErrMsg2) - else - call Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, -1, ErrStat2, ErrMsg2) - endif - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - if (p_FAST%CompAeroMaps) then - p_FAST%SizeJac_Opt1(1) = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL) - p_FAST%TolerSquared = p_FAST%TolerSquared * (p_FAST%SizeJac_Opt1(1)**2) ! do this calculation here so we don't have to keep dividing by the size of the array later - p_FAST%NumBl_Lin = 1 - else - p_FAST%NumBl_Lin = NumBl - end if - - end if - + CALL FAST_InitOutput(p_FAST, y_FAST, Init, ErrStat2, ErrMsg2) + if (Failed()) return - ! ------------------------------------------------------------------------- + !---------------------------------------------------------------------------- ! Initialize data for VTK output - ! ------------------------------------------------------------------------- + !---------------------------------------------------------------------------- + if ( p_FAST%WrVTK > VTK_None ) then - call SetVTKParameters(p_FAST, Init%OutData_ED, Init%OutData_SED, Init%OutData_AD, Init%OutData_SeaSt, Init%OutData_HD, ED, SED, BD, AD, HD, ErrStat2, ErrMsg2) + call SetVTKParameters(p_FAST, Init%OutData_ED(iED), Init%OutData_SED, Init%OutData_AD, Init%OutData_SeaSt, Init%OutData_HD, ED, SED, BD, AD, HD, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if - ! ------------------------------------------------------------------------- + !---------------------------------------------------------------------------- ! Write initialization data to FAST summary file: - ! ------------------------------------------------------------------------- + !---------------------------------------------------------------------------- + if (p_FAST%SumPrint) then CALL FAST_WrSum( p_FAST, y_FAST, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) endif - - ! ------------------------------------------------------------------------- - ! other misc variables initialized here: - ! ------------------------------------------------------------------------- + !---------------------------------------------------------------------------- + ! Other misc variables initialized + !---------------------------------------------------------------------------- m_FAST%t_global = t_initial @@ -1761,26 +1434,36 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S endif end if + !---------------------------------------------------------------------------- + ! Cleanup + !---------------------------------------------------------------------------- - - - !............................................................................................................................... - ! Destroy initializion data - !............................................................................................................................... + ! Deallocate arrays that are no longer used CALL Cleanup() CONTAINS + SUBROUTINE Cleanup() - !............................................................................................................................... - ! Destroy initializion data - !............................................................................................................................... - ! We assume that all initializion data points to parameter data, so we just nullify the pointers instead of deallocate - ! data that they point to: + ! Destroy initialization data CALL FAST_DestroyInitData( Init, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Cleanup + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call Cleanup() + end function Failed + + logical function FailedAlloc(txt) + character(*), intent(in) :: txt + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Could not allocate "//txt, ErrStat, ErrMsg, RoutineName) + call Cleanup() + endif + FailedAlloc = ErrStat >= AbortErrLev + end function FailedAlloc + SUBROUTINE SetSrvDCableControls() ! There is probably a better method for doint this, but this will work for now. Kind of an ugly bit of hacking. Init%InData_SrvD%NumCableControl = 0 @@ -1884,7 +1567,6 @@ END SUBROUTINE FAST_InitializeAll SUBROUTINE FAST_ProgStart(ThisProgVer) TYPE(ProgDesc), INTENT(IN) :: ThisProgVer !< program name/date/version description - TYPE(ProgDesc) :: NewProgVer !< program name/date/version description NewProgVer = ThisProgVer @@ -1892,7 +1574,6 @@ SUBROUTINE FAST_ProgStart(ThisProgVer) NewProgVer%Name = ProgName end if - ! ... Initialize NWTC Library ! sets the pi constants, open console for output, etc... CALL NWTC_Init( ProgNameIN=NewProgVer%Name, EchoLibVer=.FALSE. ) @@ -2257,6 +1938,8 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) IF (p%MHK /= MHK_None .and. p%Linearize) CALL SetErrStat( ErrID_Warn, 'Linearization is not fully implemented for an MHK turbine (buoyancy not included in perturbations, and added mass not included anywhere).', ErrStat, ErrMsg, RoutineName ) + IF (p%MHK /= MHK_None .and. p%CompSeaSt == Module_SeaSt .and. p%CompInflow /= Module_IfW) CALL SetErrStat( ErrID_Fatal, 'InflowWind must be activated for MHK turbines when SeaState is used.', ErrStat, ErrMsg, RoutineName ) + IF (p%Gravity < 0.0_ReKi) CALL SetErrStat( ErrID_Fatal, 'Gravity must not be negative.', ErrStat, ErrMsg, RoutineName ) IF (p%WtrDpth < 0.0_ReKi) CALL SetErrStat( ErrID_Fatal, 'WtrDpth must not be negative.', ErrStat, ErrMsg, RoutineName ) @@ -2405,7 +2088,7 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) y_FAST%Module_Ver( Module_SED ) = Init%OutData_SED%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_SED ) )) ELSE - y_FAST%Module_Ver( Module_ED ) = Init%OutData_ED%Ver + y_FAST%Module_Ver( Module_ED ) = Init%OutData_ED(iED)%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_ED ) )) END IF @@ -2483,11 +2166,15 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) IF ( ALLOCATED( Init%OutData_IfW%WriteOutputHdr ) ) y_FAST%numOuts(Module_IfW) = SIZE(Init%OutData_IfW%WriteOutputHdr) IF ( ALLOCATED( Init%OutData_ExtInfw%WriteOutputHdr ) ) y_FAST%numOuts(Module_ExtInfw) = SIZE(Init%OutData_ExtInfw%WriteOutputHdr) - IF ( ALLOCATED( Init%OutData_ED%WriteOutputHdr ) ) y_FAST%numOuts(Module_ED) = SIZE(Init%OutData_ED%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_ED ) ) then + do i = 1, NumED + IF ( ALLOCATED( Init%OutData_ED(i)%WriteOutputHdr ) ) y_FAST%numOuts(Module_ED) = y_FAST%numOuts(Module_ED) + SIZE(Init%OutData_ED(iED)%WriteOutputHdr) + end do + end if IF ( ALLOCATED( Init%OutData_SED%WriteOutputHdr ) ) y_FAST%numOuts(Module_SED) = SIZE(Init%OutData_SED%WriteOutputHdr) -do i=1,p_FAST%nBeams - 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 + do i=1,p_FAST%nBeams + 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 IF ( ALLOCATED( Init%OutData_AD%rotors)) then IF ( ALLOCATED( Init%OutData_AD%rotors(1)%WriteOutputHdr)) y_FAST%numOuts(Module_AD) = SIZE(Init%OutData_AD%rotors(1)%WriteOutputHdr) @@ -2511,7 +2198,7 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) if (p_FAST%CompAeroMaps) then y_FAST%numOuts(Module_Glue) = 1 + size(y_FAST%DriverWriteOutput) else - y_FAST%numOuts(Module_Glue) = 1 ! time + y_FAST%numOuts(Module_Glue) = 4 ! time, ConvIter, ConvError, NumUJac end if @@ -2544,11 +2231,18 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) y_FAST%ChannelNames(SS_Indx_WS+1) = 'WindSpeed' y_FAST%ChannelUnits(SS_Indx_WS+1) = '(m/s)' - else y_FAST%ChannelNames(1) = 'Time' y_FAST%ChannelUnits(1) = '(s)' + y_FAST%ChannelNames(2) = 'ConvIter' + y_FAST%ChannelUnits(2) = '(-)' + + y_FAST%ChannelNames(3) = 'ConvError' + y_FAST%ChannelUnits(3) = '(-)' + + y_FAST%ChannelNames(4) = 'NumUJac' + y_FAST%ChannelUnits(4) = '(-)' end if indxNext = y_FAST%numOuts(Module_Glue) + 1 @@ -2566,8 +2260,8 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) END DO 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) + y_FAST%ChannelNames(indxNext) = Init%OutData_ED(iED)%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_ED(iED)%WriteOutputUnt(i) indxNext = indxNext + 1 END DO @@ -2984,6 +2678,33 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS RETURN end if + + ! RhoInf - Numerical damping parameter for tight coupling generalized-alpha integrator (-) [0.0 to 1.0] + CALL ReadVar( UnIn, InputFile, p%RhoInf, "RhoInf", "Numerical damping parameter "//& + "for tight coupling generalized-alpha integrator (-) [0.0 to 1.0]", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! ConvTol - Convergence iteration error tolerance for tight coupling generalized alpha integrator (-) + CALL ReadVar( UnIn, InputFile, p%ConvTol, "ConvTol", "Convergence iteration error tolerance for tight coupling generalized alpha integrator (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! MaxConvIter - Maximum number of convergence interations for tight coupling generalized alpha integrator (-) + CALL ReadVar( UnIn, InputFile, p%MaxConvIter, "MaxConvIter", "Maximum number of convergence iterations "//& + "for tight coupling generalized alpha integrator (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + ! DT_UJac - Time between calls to get Jacobians (s) CALL ReadVar( UnIn, InputFile, p%DT_UJac, "DT_UJac", "Time between calls to get Jacobians (s)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3603,12 +3324,6 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS RETURN end if - ! temporary work-around for error with CalcSteady - if (p%CalcSteady .and. p%NLinTimes == 1 ) then - call SetErrStat(ErrID_Info, "Setting NLinTimes to 2 to avoid problem with CalcSteady with only one time.", ErrStat,ErrMsg,RoutineName) - p%NLinTimes = 2 - end if - ! LinInputs - Include inputs in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)} CALL ReadVar( UnIn, InputFile, p%LinInputs, "LinInputs", "Include inputs in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)}", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4161,8 +3876,8 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_SED, InitOutData y = SED%y%HubPtMotion%Position(3, 1) - SED%y%NacelleMotion%Position(3, 1) x = TwoNorm( SED%y%HubPtMotion%Position(1:2,1) - SED%y%NacelleMotion%Position(1:2,1) ) - p_FAST%VTK_Surface%HubRad else - 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 + y = ED%y(iED)%HubPtMotion%Position(3, 1) - ED%y(iED)%NacelleMotion%Position(3, 1) + x = TwoNorm( ED%y(iED)%HubPtMotion%Position(1:2,1) - ED%y(iED)%NacelleMotion%Position(1:2,1) ) - p_FAST%VTK_Surface%HubRad endif @@ -4178,7 +3893,7 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_SED, InitOutData !....................... ! Create the tower surface data !....................... - TowerMotionMesh => ED%y%TowerLn2Mesh + TowerMotionMesh => ED%y(iED)%TowerLn2Mesh CALL AllocAry(p_FAST%VTK_Surface%TowerRad,TowerMotionMesh%NNodes,'VTK_Surface%TowerRad',ErrStat2,ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -4267,11 +3982,11 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_SED, InitOutData ELSE call WrScr('Using generic blade surfaces for ElastoDyn (rectangular airfoil, constant chord). ') ! TODO make this an option DO K=1,NumBl - rootNode = ED%y%BladeLn2Mesh(K)%NNodes - tipNode = ED%y%BladeLn2Mesh(K)%NNodes-1 - cylNode = min(2,ED%y%BladeLn2Mesh(K)%NNodes) + rootNode = ED%y(iED)%BladeLn2Mesh(K)%NNodes + tipNode = ED%y(iED)%BladeLn2Mesh(K)%NNodes-1 + cylNode = min(2,ED%y(iED)%BladeLn2Mesh(K)%NNodes) - call SetVTKDefaultBladeParams(ED%y%BladeLn2Mesh(K), p_FAST%VTK_Surface%BladeShape(K), tipNode, rootNode, cylNode, 4, ErrStat2, ErrMsg2) + call SetVTKDefaultBladeParams(ED%y(iED)%BladeLn2Mesh(K), p_FAST%VTK_Surface%BladeShape(K), tipNode, rootNode, cylNode, 4, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) RETURN END DO @@ -5075,2375 +4790,380 @@ END SUBROUTINE FAST_WrSum !> Routine that calls FAST_Solution0 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. SUBROUTINE FAST_Solution0_T(Turbine, ErrStat, ErrMsg) + USE FAST_SolverTC, only: FAST_SolverStep0 TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - CALL FAST_Solution0(Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX,& - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) - -END SUBROUTINE FAST_Solution0_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls CalcOutput for the first time of the simulation (at t=0). After the initial solve, data arrays are initialized. -SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SC_DX, SeaSt, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, 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 - TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-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(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data - TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads data - TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data - TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller exchange data - TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState 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 - - 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 = 'FAST_Solution0' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 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 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Solution0' - - - !NOTE: m_FAST%t_global is t_initial in this routine - ErrStat = ErrID_None ErrMsg = "" + + ! NOTE: m_FAST%t_global is t_initial in this routine (used as t_global_next) + t_initial = Turbine%m_FAST%t_global + Turbine%y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_initial, Turbine%p_FAST) + + if (Turbine%p_FAST%WrSttsTime) then + call SimStatus_FirstTime(Turbine%m_FAST%TiLstPrn, Turbine%m_FAST%PrevClockTime, & + Turbine%m_FAST%SimStrtTime, Turbine%m_FAST%UsrTime2, Turbine%m_FAST%t_global, & + Turbine%p_FAST%TMax, Turbine%p_FAST%TDesc) + end if - 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, t_initial, p_FAST%TMax, p_FAST%TDesc ) - END IF - - + !---------------------------------------------------------------------------- ! Solve input-output relations; this section of code corresponds to Eq. (35) in Gasmi et al. (2013) - ! This code will be specific to the underlying modules - - ! 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%CompSeaSt == Module_SeaSt .and. y_FAST%WriteThisStep) then - ! note: SeaState has no inputs and only calculates WriteOutputs, so we don't need to call CalcOutput unless we are writing to the file - call SeaSt_CalcOutput( t_initial, SeaSt%u, SeaSt%p, SeaSt%x(1), SeaSt%xd(1), SeaSt%z(1), SeaSt%OtherSt(1), SeaSt%y, SeaSt%m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Get initial ServoDyn and IfW/Lidar inputs from Simulink + IF (Turbine%p_FAST%CompServo == Module_SrvD) then + CALL SrvD_SetExternalInputs(Turbine%p_FAST, Turbine%m_FAST, Turbine%SrvD%Input(INPUT_CURR)) end if - 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, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Perform initial solve + CALL FAST_SolverStep0(Turbine%p_Glue%TC, Turbine%m_Glue%TC, Turbine%m_Glue%ModData, & + Turbine%m_Glue%Mappings, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return - if (p_FAST%UseSC ) then - call SC_DX_SetInputs(p_FAST, SrvD%y, SC_DX, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (Turbine%p_FAST%UseSC ) then + call SC_DX_SetInputs(Turbine%p_FAST, Turbine%SrvD%y, Turbine%SC_DX, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end if - !---------------------------------------------------------------------------------------- - ! Check to see if we should output data this time step: - !---------------------------------------------------------------------------------------- - - CALL WriteOutputToFile(n_t_global_next, t_initial, p_FAST, y_FAST, ED, SED, BD, AD, ADsk, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !---------------------------------------------------------------------------- + ! Write output to file + !---------------------------------------------------------------------------- + + ! Write module output to file + CALL WriteOutputToFile(n_t_global_next, t_initial, Turbine%p_FAST, & + Turbine%y_FAST, Turbine%ED, Turbine%SED, Turbine%BD, & + Turbine%AD, Turbine%ADsk, Turbine%IfW, Turbine%ExtInfw, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, & + Turbine%ExtPtfm, Turbine%SrvD, Turbine%MAP, & + Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%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) - - call WriteVTK(t_initial, p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - + if (Turbine%p_FAST%WrVTK == VTK_InitOnly) then + call WriteVTK(t_initial, Turbine%p_FAST, Turbine%y_FAST, & + Turbine%MeshMapData, Turbine%ED, Turbine%SED, Turbine%BD, Turbine%AD, & + Turbine%IfW, Turbine%ExtInfw, Turbine%SeaSt, Turbine%HD, & + Turbine%SD, Turbine%ExtPtfm, Turbine%SrvD, Turbine%MAP, & + Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD) end if + !---------------------------------------------------------------------------- + ! Populate inputs at for ExtrapInterp and copy current state to predicted state + !---------------------------------------------------------------------------- - !............... - ! Copy values of these initial guesses for interpolation/extrapolation and - ! initialize predicted states for j_pc loop (use MESH_NEWCOPY here so we can use MESH_UPDATE copy later) - !............... - - ! Initialize Input-Output arrays for interpolation/extrapolation: - - CALL FAST_InitIOarrays( m_FAST%t_global, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, IfW, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Initialize input and state arrays for all modules + call FAST_InitInputStateArrays(Turbine%m_Glue%ModData, t_initial, & + Turbine%p_FAST%DT, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + ! Copy solver current state to previous state + call Glue_CopyTC_State(Turbine%m_Glue%TC%StatePred, Turbine%m_Glue%TC%StateCurr, & + MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return -END SUBROUTINE FAST_Solution0 +END SUBROUTINE FAST_Solution0_T !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the input and output arrays stored for extrapolation. They are initialized after the first input-output solve so that the first -!! extrapolations are used with values from the solution, not just initial guesses. It also creates new copies of the state variables, which need to -!! be stored for the predictor-corrector loop. -SUBROUTINE FAST_InitIOarrays( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, IfW, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat, ErrMsg ) +!> Routine that calls FAST_InitIOarrays_SubStep 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. +SUBROUTINE FAST_InitIOarrays_SubStep_T(t_initial, Turbine, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_initial !< start time of the simulation - 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 - TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-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(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk 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_MCKF 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_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine 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, j, k ! loop counters INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitIOarrays' - + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitIOarrays_SubStep_T' + INTEGER(IntKi) :: i, j ErrStat = ErrID_None ErrMsg = "" - ! We fill (S)ED%InputTimes with negative times, but the (S)ED%Input values are identical for each of those times; this allows - ! us to use, e.g., quadratic interpolation that effectively acts as a zeroth-order extrapolation and first-order extrapolation - ! for the first and second time steps. (The interpolation order in the ExtrapInput routines are determined as - ! order = SIZE(ED%Input) - - IF (p_FAST%CompElast == Module_SED) THEN - DO j = 1, p_FAST%InterpOrder + 1 - SED%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - END DO - - DO j = 2, p_FAST%InterpOrder + 1 - CALL SED_CopyInput (SED%Input(1), SED%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL SED_CopyInput (SED%Input(1), SED%u, 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 SED_CopyContState (SED%x( STATE_CURR), SED%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SED_CopyDiscState (SED%xd(STATE_CURR), SED%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SED_CopyConstrState (SED%z( STATE_CURR), SED%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SED_CopyOtherState (SED%OtherSt( STATE_CURR), SED%OtherSt( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSE - - DO j = 1, p_FAST%InterpOrder + 1 - ED%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - END DO - - 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 ) - 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 ) - - ! 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 ) - CALL ED_CopyDiscState (ED%xd(STATE_CURR), ED%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_CURR), ED%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), ED%OtherSt( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ENDIF + ! Loop through modules + do i = 1, size(Turbine%m_Glue%ModData) - IF (p_FAST%CompElast == Module_BD ) THEN + ! Copy from current input to input save locations + do j = 1, Turbine%p_FAST%InterpOrder + 1 + call FAST_CopyInput(Turbine%m_Glue%ModData(i), Turbine, INPUT_CURR, -j, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat > AbortErrLev) return + end do - DO k = 1,p_FAST%nBeams + ! Copy from current state to saved current state + call FAST_CopyStates(Turbine%m_Glue%ModData(i), Turbine, STATE_CURR, STATE_SAVED_CURR, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat > AbortErrLev) return - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - BD%InputTimes(j,k) = t_initial - (j - 1) * p_FAST%dt - END DO + ! Copy from predicted state to saved predicted state + call FAST_CopyStates(Turbine%m_Glue%ModData(i), Turbine, STATE_PRED, STATE_SAVED_PRED, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat > AbortErrLev) return - DO j = 2, p_FAST%InterpOrder + 1 - CALL BD_CopyInput (BD%Input(1,k), BD%Input(j,k), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL BD_CopyInput (BD%Input(1,k), BD%u(k), MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end do +END SUBROUTINE FAST_InitIOarrays_SubStep_T - ! Initialize predicted states for j_pc loop: - CALL BD_CopyContState (BD%x( k,STATE_CURR), BD%x( k,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_CURR), BD%xd(k,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_CURR), BD%z( k,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_CURR), BD%OtherSt( k,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_Reset_SubStep 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. +SUBROUTINE FAST_Reset_SubStep_T(t_initial, n_t_global, n_timesteps, Turbine, ErrStat, ErrMsg ) - END DO ! nBeams + USE BladedInterface, ONLY: CallBladedDLL ! Hack for Bladed-style DLL - END IF ! CompElast + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + INTEGER(IntKi), INTENT(IN ) :: n_timesteps !< number of time steps to go back + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Reset_SubStep_T' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore + REAL(DbKi) :: t_global ! the time to which states, inputs and outputs are reset + REAL(DbKi), allocatable :: InputTimes(:) + INTEGER(IntKi) :: i, j + + ErrStat = ErrID_None + ErrMsg = "" - IF ( p_FAST%CompServo == Module_SrvD ) THEN - ! Initialize Input-Output arrays for interpolation/extrapolation: + ! Calculate input times + t_global = t_initial + n_t_global * Turbine%p_FAST%DT + InputTimes = [(t_global - (j - 1) * Turbine%p_FAST%DT, j = 1, Turbine%p_FAST%InterpOrder + 1)] - DO j = 1, p_FAST%InterpOrder + 1 - SrvD%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - !SrvD_OutputTimes(j) = t_initial - (j - 1) * dt - END DO + ! Update the global time + Turbine%m_FAST%t_global = t_global - DO j = 2, p_FAST%InterpOrder + 1 - CALL SrvD_CopyInput (SrvD%Input(1), SrvD%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL SrvD_CopyInput (SrvD%Input(1), SrvD%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Loop through modules + do i = 1, size(Turbine%m_Glue%ModData) + associate (ModData => Turbine%m_Glue%ModData(i)) - ! Initialize predicted states for j_pc loop: - CALL SrvD_CopyContState (SrvD%x( STATE_CURR), SrvD%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyDiscState (SrvD%xd(STATE_CURR), SrvD%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyConstrState (SrvD%z( STATE_CURR), SrvD%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyOtherState( SrvD%OtherSt(STATE_CURR), SrvD%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Copy from current input to input save locations + do j = 1, Turbine%p_FAST%InterpOrder + 1 + call FAST_CopyInput(ModData, Turbine, -j, j, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat > AbortErrLev) return + end do - END IF ! CompServo + ! Copy from current state to saved current state + call FAST_CopyStates(ModData, Turbine, STATE_SAVED_CURR, STATE_CURR, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat > AbortErrLev) return + + ! Copy from predicted state to saved predicted state + call FAST_CopyStates(ModData, Turbine, STATE_SAVED_PRED, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat > AbortErrLev) return + + ! Select based on module ID + select case (ModData%ID) + case (Module_AD) + Turbine%AD%InputTimes = InputTimes + case (Module_BD) + Turbine%BD%InputTimes(:, ModData%Ins) = InputTimes + case (Module_ED) + Turbine%ED%InputTimes(:, ModData%Ins) = InputTimes + case (Module_ExtPtfm) + Turbine%ExtPtfm%InputTimes = InputTimes + case (Module_FEAM) + case (Module_HD) + Turbine%HD%InputTimes = InputTimes + case (Module_IceD) + Turbine%IceD%InputTimes(:, ModData%Ins) = InputTimes + case (Module_IceF) + Turbine%IceF%InputTimes = InputTimes + case (Module_IfW) + Turbine%IfW%InputTimes = InputTimes + case (Module_MAP) + Turbine%MAP%InputTimes = InputTimes + case (Module_MD) + Turbine%MD%InputTimes = InputTimes +! case (Module_ExtInfw) +! Turbine%ExtInfw%InputTimes = InputTimes + case (Module_Orca) + Turbine%Orca%InputTimes = InputTimes + case (Module_SD) + Turbine%SD%InputTimes = InputTimes + case (Module_SeaSt) + Turbine%SeaSt%InputTimes = InputTimes + case (Module_SrvD) + Turbine%SrvD%InputTimes = InputTimes + + ! A hack to restore Bladed-style DLL data + if (Turbine%SrvD%p%UseBladedInterface) then + 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) + Turbine%SrvD%m%dll_data%avrSWAP( 1) = -10 + 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%m%dll_data%avrSWAP( 1) = old_avrSwap1 + end if + end if + case default + call SetErrStat(ErrID_Fatal, "Unknown module "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select - IF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN - ! Copy values for interpolation/extrapolation: + end associate + end do - DO j = 1, p_FAST%InterpOrder + 1 - AD%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - END DO +END SUBROUTINE FAST_Reset_SubStep_T - DO j = 2, p_FAST%InterpOrder + 1 - CALL AD_CopyInput (AD%Input(1), AD%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL AD_CopyInput (AD%Input(1), AD%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_Store_SubStep 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. +SUBROUTINE FAST_Store_SubStep_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) + USE BladedInterface, ONLY: CallBladedDLL ! Hack for Bladed-style DLL - ! Initialize predicted states for j_pc loop: - CALL AD_CopyContState(AD%x(STATE_CURR), AD%x(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState(AD%xd(STATE_CURR), AD%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState(AD%z(STATE_CURR), AD%z(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState(AD%OtherSt(STATE_CURR), AD%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Store_SubStep_T' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + INTEGER(IntKi) :: i, j ! generic loop counters + REAL(DbKi) :: t_global ! the time to which states, inputs and outputs are reset + INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore - ELSEIF ( p_FAST%CompAero == Module_ADsk ) THEN - ! Copy values for interpolation/extrapolation: + ErrStat = ErrID_None + ErrMsg = "" - DO j = 1, p_FAST%InterpOrder + 1 - ADsk%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - END DO + t_global = t_initial + n_t_global * Turbine%p_FAST%DT - DO j = 2, p_FAST%InterpOrder + 1 - CALL ADsk_CopyInput (ADsk%Input(1), ADsk%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL ADsk_CopyInput (ADsk%Input(1), ADsk%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Loop through modules + do i = 1, size(Turbine%m_Glue%ModData) + associate (ModData => Turbine%m_Glue%ModData(i)) + ! Copy from current input to input save locations + do j = 1, Turbine%p_FAST%InterpOrder + 1 + call FAST_CopyInput(ModData, Turbine, j, -j, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat > AbortErrLev) return + end do - ! Initialize predicted states for j_pc loop: - CALL ADsk_CopyContState (ADsk%x( STATE_CURR), ADsk%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ADsk_CopyDiscState (ADsk%xd(STATE_CURR), ADsk%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ADsk_CopyConstrState (ADsk%z( STATE_CURR), ADsk%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ADsk_CopyOtherState( ADsk%OtherSt(STATE_CURR), ADsk%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Copy from current state to saved current state + call FAST_CopyStates(ModData, Turbine, STATE_CURR, STATE_SAVED_CURR, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat > AbortErrLev) return + + ! Copy from predicted state to saved predicted state + call FAST_CopyStates(ModData, Turbine, STATE_PRED, STATE_SAVED_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat > AbortErrLev) return + + ! A hack to store Bladed-style DLL data + if (ModData%ID == Module_SrvD) then + if (Turbine%SrvD%p%UseBladedInterface) then + 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) + Turbine%SrvD%m%dll_data%avrSWAP(1) = -11 + 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%m%dll_data%avrSWAP(1) = old_avrSwap1 + end if + end if + end if - END IF ! CompAero == Module_AD + end associate + end do +END SUBROUTINE FAST_Store_SubStep_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_Solution 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. +SUBROUTINE FAST_Solution_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) - IF ( p_FAST%CompInflow == Module_IfW ) THEN - ! Copy values for interpolation/extrapolation: + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - DO j = 1, p_FAST%InterpOrder + 1 - IfW%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - !IfW%OutputTimes(i) = t_initial - (j - 1) * dt - END DO + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Solution' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 + REAL(R8Ki) :: t_global_next - DO j = 2, p_FAST%InterpOrder + 1 - CALL InflowWind_CopyInput (IfW%Input(1), IfW%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL InflowWind_CopyInput (IfW%Input(1), IfW%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ErrStat = ErrID_None + ErrMsg = '' + ! Calculate next global time + n_t_global_next = n_t_global + 1 + t_global_next = t_initial + n_t_global_next*Turbine%p_FAST%DT - ! Initialize predicted states for j_pc loop: - CALL InflowWind_CopyContState (IfW%x( STATE_CURR), IfW%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_CURR), IfW%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_CURR), IfW%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState( IfW%OtherSt(STATE_CURR), IfW%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !---------------------------------------------------------------------------- + ! Step 1.a: set some variables and Extrapolate Inputs + !---------------------------------------------------------------------------- - END IF ! CompInflow == Module_IfW + call FAST_Prework_T(t_initial, n_t_global, Turbine, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + !---------------------------------------------------------------------------- + ! Step 1.b: Advance states (yield state and constraint values at t_global_next) + ! Step 1.c: Input-Output Solve + ! Step 2: Correct (continue in loop) + !---------------------------------------------------------------------------- - IF ( p_FAST%CompHydro == Module_HD ) THEN - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - HD%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - !HD_OutputTimes(i) = t_initial - (j - 1) * dt - END DO + call FAST_UpdateStates_T(t_initial, n_t_global, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - DO j = 2, p_FAST%InterpOrder + 1 - CALL HydroDyn_CopyInput (HD%Input(1), HD%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL HydroDyn_CopyInput (HD%Input(1), HD%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !---------------------------------------------------------------------------- + ! Step 3: Save all final variables (advance to next time) and reset global time + !---------------------------------------------------------------------------- + call FAST_AdvanceToNextTimeStep_T(t_initial, n_t_global, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! Initialize predicted states for j_pc loop: - CALL HydroDyn_CopyContState (HD%x( STATE_CURR), HD%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyDiscState (HD%xd(STATE_CURR), HD%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyConstrState (HD%z( STATE_CURR), HD%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOtherState( HD%OtherSt(STATE_CURR), HD%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !---------------------------------------------------------------------------- + ! Write output data to file + !---------------------------------------------------------------------------- - END IF !CompHydro + call WriteOutputToFile(n_t_global_next, t_global_next, Turbine%p_FAST, Turbine%y_FAST, Turbine%ED, Turbine%SED, Turbine%BD, & + Turbine%AD, Turbine%ADsk, Turbine%IfW, Turbine%ExtInfw, Turbine%SeaSt, Turbine%HD, Turbine%SD, & + Turbine%ExtPtfm, Turbine%SrvD, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + !---------------------------------------------------------------------------- + ! Display simulation status every SttsTime-seconds (i.e., n_SttsTime steps): + !---------------------------------------------------------------------------- - IF (p_FAST%CompSub == Module_SD ) THEN + if (Turbine%p_FAST%WrSttsTime) then + if (MOD(n_t_global_next, Turbine%p_FAST%n_SttsTime) == 0) then + call SimStatus(Turbine%m_FAST%TiLstPrn, Turbine%m_FAST%PrevClockTime, & + Turbine%m_FAST%t_global, Turbine%p_FAST%TMax, Turbine%p_FAST%TDesc) + end if + end if - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - SD%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - !SD_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - - DO j = 2, p_FAST%InterpOrder + 1 - CALL SD_CopyInput (SD%Input(1), SD%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL SD_CopyInput (SD%Input(1), SD%u, 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 SD_CopyContState (SD%x( STATE_CURR), SD%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyDiscState (SD%xd(STATE_CURR), SD%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyConstrState (SD%z( STATE_CURR), SD%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyOtherState( SD%OtherSt(STATE_CURR), SD%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSE IF (p_FAST%CompSub == Module_ExtPtfm ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - ExtPtfm%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - END DO - - DO j = 2, p_FAST%InterpOrder + 1 - CALL ExtPtfm_CopyInput (ExtPtfm%Input(1), ExtPtfm%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL ExtPtfm_CopyInput (ExtPtfm%Input(1), ExtPtfm%u, 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 ExtPtfm_CopyContState (ExtPtfm%x( STATE_CURR), ExtPtfm%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_CURR), ExtPtfm%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_CURR), ExtPtfm%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyOtherState( ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF ! CompSub - - - IF (p_FAST%CompMooring == Module_MAP) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - MAPp%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - !MAP_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - - DO j = 2, p_FAST%InterpOrder + 1 - CALL MAP_CopyInput (MAPp%Input(1), MAPp%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL MAP_CopyInput (MAPp%Input(1), MAPp%u, 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 MAP_CopyContState (MAPp%x( STATE_CURR), MAPp%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyDiscState (MAPp%xd(STATE_CURR), MAPp%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyConstrState (MAPp%z( STATE_CURR), MAPp%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( p_FAST%n_substeps( MODULE_MAP ) > 1 ) THEN - CALL MAP_CopyOtherState( MAPp%OtherSt, MAPp%OtherSt_old, MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - ELSEIF (p_FAST%CompMooring == Module_MD) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - MD%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - !MD_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - - DO j = 2, p_FAST%InterpOrder + 1 - CALL MD_CopyInput (MD%Input(1), MD%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL MD_CopyInput (MD%Input(1), MD%u, 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 MD_CopyContState (MD%x( STATE_CURR), MD%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyDiscState (MD%xd(STATE_CURR), MD%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyConstrState (MD%z( STATE_CURR), MD%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyOtherState( MD%OtherSt(STATE_CURR), MD%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - FEAM%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - !FEAM_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - - DO j = 2, p_FAST%InterpOrder + 1 - CALL FEAM_CopyInput (FEAM%Input(1), FEAM%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL FEAM_CopyInput (FEAM%Input(1), FEAM%u, 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 FEAM_CopyContState (FEAM%x( STATE_CURR), FEAM%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyDiscState (FEAM%xd(STATE_CURR), FEAM%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyConstrState (FEAM%z( STATE_CURR), FEAM%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyOtherState( FEAM%OtherSt(STATE_CURR), FEAM%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompMooring == Module_Orca) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - Orca%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - END DO - - DO j = 2, p_FAST%InterpOrder + 1 - CALL Orca_CopyInput (Orca%Input(1), Orca%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL Orca_CopyInput (Orca%Input(1), Orca%u, 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 Orca_CopyContState (Orca%x( STATE_CURR), Orca%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyDiscState (Orca%xd(STATE_CURR), Orca%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyConstrState (Orca%z( STATE_CURR), Orca%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyOtherState( Orca%OtherSt(STATE_CURR), Orca%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF ! CompMooring - - - IF (p_FAST%CompIce == Module_IceF ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - IceF%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - !IceF_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - - DO j = 2, p_FAST%InterpOrder + 1 - CALL IceFloe_CopyInput (IceF%Input(1), IceF%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL IceFloe_CopyInput (IceF%Input(1), IceF%u, 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 IceFloe_CopyContState (IceF%x( STATE_CURR), IceF%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyDiscState (IceF%xd(STATE_CURR), IceF%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyConstrState (IceF%z( STATE_CURR), IceF%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyOtherState( IceF%OtherSt(STATE_CURR), IceF%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompIce == Module_IceD ) THEN - - DO i = 1,p_FAST%numIceLegs - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - IceD%InputTimes(j,i) = t_initial - (j - 1) * p_FAST%dt - !IceD%OutputTimes(j,i) = t_initial - (j - 1) * dt - END DO - - DO j = 2, p_FAST%InterpOrder + 1 - CALL IceD_CopyInput (IceD%Input(1,i), IceD%Input(j,i), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL IceD_CopyInput (IceD%Input(1,i), IceD%u(i), 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 IceD_CopyContState (IceD%x( i,STATE_CURR), IceD%x( i,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyDiscState (IceD%xd(i,STATE_CURR), IceD%xd(i,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyConstrState (IceD%z( i,STATE_CURR), IceD%z( i,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyOtherState( IceD%OtherSt(i,STATE_CURR), IceD%OtherSt(i,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END DO ! numIceLegs - - END IF ! CompIce - - -END SUBROUTINE FAST_InitIOarrays -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls FAST_InitIOarrays_SubStep 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. -SUBROUTINE FAST_InitIOarrays_SubStep_T(t_initial, Turbine, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< start time of the simulation - TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine - 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 = 'FAST_InitIOarrays_SubStep_T' - - CALL FAST_InitIOarrays_SubStep(t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ExtLd, Turbine%IfW, & - 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 ) - - -END SUBROUTINE FAST_InitIOarrays_SubStep_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the input and output arrays stored for extrapolation when used in a sub-timestepping mode with an external driver program. They are initialized after the first input-output solve so that the first -!! extrapolations are used with values from the solution, not just initial guesses. It also creates new copies of the state variables, which need to -!! be stored for the predictor-corrector loop. -SUBROUTINE FAST_InitIOarrays_SubStep( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, ExtLd, IfW, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< start time of the simulation - 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 - 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(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads 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_MCKF 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 - - 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, j, k ! loop counters - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitIOarrays_SubStep' - - - ErrStat = ErrID_None - ErrMsg = "" - - ! We fill ED%InputTimes with negative times, but the ED%Input values are identical for each of those times; this allows - ! us to use, e.g., quadratic interpolation that effectively acts as a zeroth-order extrapolation and first-order extrapolation - ! 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_Saved(j) = t_initial - (j - 1) * p_FAST%dt - !ED_OutputTimes(p_FAST%InterpOrder + 1 + j) = t_initial - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL ED_CopyInput (ED%Input(1), ED%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ED_CopyOutput (ED%y, ED%Output_bak(1), 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_CopyContState (ED%x( STATE_CURR), ED%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_CURR), ED%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_CURR), ED%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), ED%OtherSt( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ED_CopyContState (ED%x( STATE_PRED), ED%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_PRED), ED%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_PRED), ED%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_PRED), ED%OtherSt( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - IF (p_FAST%CompElast == Module_BD ) THEN - - DO k = 1,p_FAST%nBeams - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - BD%InputTimes_Saved(j,k) = t_initial - (j - 1) * p_FAST%dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL BD_CopyInput (BD%Input(1,k), BD%Input_Saved(j,k), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL BD_CopyContState (BD%x( k,STATE_CURR), BD%x( k,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_CURR), BD%xd(k,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_CURR), BD%z( k,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_CURR), BD%OtherSt( k,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL BD_CopyContState (BD%x( k,STATE_PRED), BD%x( k,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_PRED), BD%xd(k,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_PRED), BD%z( k,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_PRED), BD%OtherSt( k,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END DO ! nBeams - - END IF ! CompElast - - - IF ( p_FAST%CompServo == Module_SrvD ) THEN - ! Initialize Input-Output arrays for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - SrvD%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - !SrvD_OutputTimes(j) = t_initial - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL SrvD_CopyInput (SrvD%Input(1), SrvD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL SrvD_CopyContState (SrvD%x( STATE_CURR), SrvD%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyDiscState (SrvD%xd(STATE_CURR), SrvD%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyConstrState (SrvD%z( STATE_CURR), SrvD%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyOtherState( SrvD%OtherSt(STATE_CURR), SrvD%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL SrvD_CopyContState (SrvD%x( STATE_PRED), SrvD%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyDiscState (SrvD%xd(STATE_PRED), SrvD%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyConstrState (SrvD%z( STATE_PRED), SrvD%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyOtherState( SrvD%OtherSt(STATE_PRED), SrvD%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL SrvD_CopyMisc( SrvD%m, SrvD%m_bak, MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompServo - - - IF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - AD%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL AD_CopyInput (AD%Input(1), AD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL AD_CopyContState(AD%x(STATE_CURR), AD%x(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState(AD%xd(STATE_CURR), AD%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState(AD%z(STATE_CURR), AD%z(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState(AD%OtherSt(STATE_CURR), AD%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL AD_CopyContState(AD%x(STATE_PRED), AD%x(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState(AD%xd(STATE_PRED), AD%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState(AD%z(STATE_PRED), AD%z(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState(AD%OtherSt(STATE_PRED), AD%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompAero == Module_AD - - - - IF ( p_FAST%CompInflow == Module_IfW ) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - IfW%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - !IfW%OutputTimes(i) = t_initial - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL InflowWind_CopyInput (IfW%Input(1), IfW%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL InflowWind_CopyContState (IfW%x( STATE_CURR), IfW%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_CURR), IfW%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_CURR), IfW%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState( IfW%OtherSt(STATE_CURR), IfW%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL InflowWind_CopyContState (IfW%x( STATE_PRED), IfW%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_PRED), IfW%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_PRED), IfW%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState( IfW%OtherSt(STATE_PRED), IfW%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompInflow == Module_IfW - - - IF ( p_FAST%CompHydro == Module_HD ) THEN - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - HD%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - !HD_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL HydroDyn_CopyInput (HD%Input(1), HD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL HydroDyn_CopyContState (HD%x( STATE_CURR), HD%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyDiscState (HD%xd(STATE_CURR), HD%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyConstrState (HD%z( STATE_CURR), HD%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOtherState( HD%OtherSt(STATE_CURR), HD%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL HydroDyn_CopyContState (HD%x( STATE_PRED), HD%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyDiscState (HD%xd(STATE_PRED), HD%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyConstrState (HD%z( STATE_PRED), HD%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOtherState( HD%OtherSt(STATE_PRED), HD%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF !CompHydro - - - IF (p_FAST%CompSub == Module_SD ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - SD%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - !SD_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL SD_CopyInput (SD%Input(1), SD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL SD_CopyContState (SD%x( STATE_CURR), SD%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyDiscState (SD%xd(STATE_CURR), SD%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyConstrState (SD%z( STATE_CURR), SD%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyOtherState( SD%OtherSt(STATE_CURR), SD%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL SD_CopyContState (SD%x( STATE_PRED), SD%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyDiscState (SD%xd(STATE_PRED), SD%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyConstrState (SD%z( STATE_PRED), SD%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyOtherState( SD%OtherSt(STATE_PRED), SD%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSE IF (p_FAST%CompSub == Module_ExtPtfm ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - ExtPtfm%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL ExtPtfm_CopyInput (ExtPtfm%Input(1), ExtPtfm%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_CURR), ExtPtfm%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_CURR), ExtPtfm%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_CURR), ExtPtfm%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyOtherState( ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_PRED), ExtPtfm%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_PRED), ExtPtfm%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_PRED), ExtPtfm%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyOtherState( ExtPtfm%OtherSt(STATE_PRED), ExtPtfm%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompSub - - - IF (p_FAST%CompMooring == Module_MAP) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - MAPp%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - !MAP_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL MAP_CopyInput (MAPp%Input(1), MAPp%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL MAP_CopyContState (MAPp%x( STATE_CURR), MAPp%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyDiscState (MAPp%xd(STATE_CURR), MAPp%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyConstrState (MAPp%z( STATE_CURR), MAPp%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( p_FAST%n_substeps( MODULE_MAP ) > 1 ) THEN - CALL MAP_CopyOtherState( MAPp%OtherSt, MAPp%OtherSt_old, MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - ! Initialize predicted states for j_pc loop: - CALL MAP_CopyContState (MAPp%x( STATE_PRED), MAPp%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyDiscState (MAPp%xd(STATE_PRED), MAPp%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyConstrState (MAPp%z( STATE_PRED), MAPp%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( p_FAST%n_substeps( MODULE_MAP ) > 1 ) THEN - CALL MAP_CopyOtherState( MAPp%OtherSt, MAPp%OtherSt_old, MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - ELSEIF (p_FAST%CompMooring == Module_MD) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - MD%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - !MD_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL MD_CopyInput (MD%Input(1), MD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL MD_CopyContState (MD%x( STATE_CURR), MD%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyDiscState (MD%xd(STATE_CURR), MD%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyConstrState (MD%z( STATE_CURR), MD%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyOtherState( MD%OtherSt(STATE_CURR), MD%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL MD_CopyContState (MD%x( STATE_PRED), MD%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyDiscState (MD%xd(STATE_PRED), MD%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyConstrState (MD%z( STATE_PRED), MD%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyOtherState( MD%OtherSt(STATE_PRED), MD%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - - - ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - FEAM%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - !FEAM_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL FEAM_CopyInput (FEAM%Input(1), FEAM%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL FEAM_CopyContState (FEAM%x( STATE_CURR), FEAM%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyDiscState (FEAM%xd(STATE_CURR), FEAM%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyConstrState (FEAM%z( STATE_CURR), FEAM%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyOtherState( FEAM%OtherSt(STATE_CURR), FEAM%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL FEAM_CopyContState (FEAM%x( STATE_PRED), FEAM%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyDiscState (FEAM%xd(STATE_PRED), FEAM%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyConstrState (FEAM%z( STATE_PRED), FEAM%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyOtherState( FEAM%OtherSt(STATE_PRED), FEAM%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompMooring == Module_Orca) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - Orca%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL Orca_CopyInput (Orca%Input(1), Orca%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL Orca_CopyContState (Orca%x( STATE_CURR), Orca%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyDiscState (Orca%xd(STATE_CURR), Orca%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyConstrState (Orca%z( STATE_CURR), Orca%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyOtherState( Orca%OtherSt(STATE_CURR), Orca%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL Orca_CopyContState (Orca%x( STATE_PRED), Orca%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyDiscState (Orca%xd(STATE_PRED), Orca%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyConstrState (Orca%z( STATE_PRED), Orca%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyOtherState( Orca%OtherSt(STATE_PRED), Orca%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompMooring - - - IF (p_FAST%CompIce == Module_IceF ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - IceF%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt - !IceF_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL IceFloe_CopyInput (IceF%Input(1), IceF%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL IceFloe_CopyContState (IceF%x( STATE_CURR), IceF%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyDiscState (IceF%xd(STATE_CURR), IceF%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyConstrState (IceF%z( STATE_CURR), IceF%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyOtherState( IceF%OtherSt(STATE_CURR), IceF%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL IceFloe_CopyContState (IceF%x( STATE_PRED), IceF%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyDiscState (IceF%xd(STATE_PRED), IceF%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyConstrState (IceF%z( STATE_PRED), IceF%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyOtherState( IceF%OtherSt(STATE_PRED), IceF%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompIce == Module_IceD ) THEN - - DO i = 1,p_FAST%numIceLegs - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - IceD%InputTimes_Saved(j,i) = t_initial - (j - 1) * p_FAST%dt - !IceD%OutputTimes(j,i) = t_initial - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL IceD_CopyInput (IceD%Input(1,i), IceD%Input_Saved(j,i), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Initialize predicted states for j_pc loop: - CALL IceD_CopyContState (IceD%x( i,STATE_CURR), IceD%x( i,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyDiscState (IceD%xd(i,STATE_CURR), IceD%xd(i,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyConstrState (IceD%z( i,STATE_CURR), IceD%z( i,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyOtherState( IceD%OtherSt(i,STATE_CURR), IceD%OtherSt(i,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL IceD_CopyContState (IceD%x( i,STATE_PRED), IceD%x( i,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyDiscState (IceD%xd(i,STATE_PRED), IceD%xd(i,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyConstrState (IceD%z( i,STATE_PRED), IceD%z( i,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyOtherState( IceD%OtherSt(i,STATE_PRED), IceD%OtherSt(i,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END DO ! numIceLegs - - END IF ! CompIce - - -END SUBROUTINE FAST_InitIOarrays_SubStep -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls FAST_Reset_SubStep 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. -SUBROUTINE FAST_Reset_SubStep_T(t_initial, n_t_global, n_timesteps, Turbine, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - INTEGER(IntKi), INTENT(IN ) :: n_timesteps !< number of time steps to go back - TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - CALL FAST_Reset_SubStep(t_initial, n_t_global, n_timesteps, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) - -END SUBROUTINE FAST_Reset_SubStep_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine resets the states, inputs and output data from n_t_global to n_t_global - 1 -SUBROUTINE FAST_Reset_SubStep(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) - - USE BladedInterface, ONLY: CallBladedDLL ! Hack for Bladed-style DLL - - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - INTEGER(IntKi), INTENT(IN ) :: n_timesteps !< number of time steps to go back - - 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(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow 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 - - 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, j, k ! generic loop counters - REAL(DbKi) :: t_global ! the time to which states, inputs and outputs are reset - INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Reset_SubStep' - - - ErrStat = ErrID_None - ErrMsg = "" - - - t_global = t_initial + n_t_global * p_FAST%DT - - !---------------------------------------------------------------------------------------- - !! copy the stored states and inputs from n_t_global the current states and inputs - !---------------------------------------------------------------------------------------- - - DO j = 1, p_FAST%InterpOrder + 1 - ED%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - !ED_OutputTimes(j) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL ED_CopyInput (ED%Input_Saved(j), ED%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL ED_CopyOutput (ED%Output_bak(1), ED%y, MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! ElastoDyn: copy final predictions to actual states - CALL ED_CopyContState (ED%x( STATE_SAVED_PRED), ED%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_SAVED_PRED), ED%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_SAVED_PRED), ED%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_SAVED_PRED), ED%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ED_CopyContState (ED%x( STATE_SAVED_CURR), ED%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_SAVED_CURR), ED%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_SAVED_CURR), ED%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_SAVED_CURR), ED%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - - IF (p_FAST%CompElast == Module_BD ) THEN - - DO k = 1,p_FAST%nBeams - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - BD%InputTimes(j,k) = t_global - (j - 1) * p_FAST%dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL BD_CopyInput (BD%Input_Saved(j,k), BD%Input(j,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL BD_CopyContState (BD%x( k,STATE_SAVED_PRED), BD%x( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_SAVED_PRED), BD%xd(k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_SAVED_PRED), BD%z( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_SAVED_PRED), BD%OtherSt( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL BD_CopyContState (BD%x( k,STATE_SAVED_CURR), BD%x( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_SAVED_CURR), BD%xd(k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_SAVED_CURR), BD%z( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_SAVED_CURR), BD%OtherSt( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - END IF - - IF ( p_FAST%CompServo == Module_SrvD ) THEN - - ! A hack to restore Bladed-style DLL data - if (SrvD%p%UseBladedInterface) then - if (SrvD%m%dll_data%avrSWAP( 1) > 0 ) then ! this isn't allocated if UseBladedInterface is FALSE - ! store value to be overwritten - old_avrSwap1 = SrvD%m%dll_data%avrSWAP( 1) - SrvD%m%dll_data%avrSWAP( 1) = -10 - CALL CallBladedDLL(SrvD%Input(1), SrvD%p, SrvD%m%dll_data, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! put values back: - SrvD%m%dll_data%avrSWAP( 1) = old_avrSwap1 - end if - end if - - ! Initialize Input-Output arrays for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - SrvD%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL SrvD_CopyInput (SrvD%Input_Saved(j), SrvD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL SrvD_CopyContState (SrvD%x( STATE_SAVED_PRED), SrvD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyDiscState (SrvD%xd(STATE_SAVED_PRED), SrvD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyConstrState (SrvD%z( STATE_SAVED_PRED), SrvD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_SAVED_PRED), SrvD%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL SrvD_CopyContState (SrvD%x( STATE_SAVED_CURR), SrvD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyDiscState (SrvD%xd(STATE_SAVED_CURR), SrvD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyConstrState (SrvD%z( STATE_SAVED_CURR), SrvD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_SAVED_CURR), SrvD%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL SrvD_CopyMisc( SrvD%m_bak, SrvD%m, MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF - - IF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - AD%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL AD_CopyInput (AD%Input_Saved(j), AD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL AD_CopyContState (AD%x( STATE_SAVED_PRED), AD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState (AD%xd(STATE_SAVED_PRED), AD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState (AD%z( STATE_SAVED_PRED), AD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState (AD%OtherSt(STATE_SAVED_PRED), AD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL AD_CopyContState (AD%x( STATE_SAVED_CURR), AD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState (AD%xd(STATE_SAVED_CURR), AD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState (AD%z( STATE_SAVED_CURR), AD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState (AD%OtherSt(STATE_SAVED_CURR), AD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompAero == Module_AD - - IF ( p_FAST%CompInflow == Module_IfW ) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - IfW%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - !IfW%OutputTimes(i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL InflowWind_CopyInput (IfW%Input_Saved(j), IfW%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL InflowWind_CopyContState (IfW%x( STATE_SAVED_PRED), IfW%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_SAVED_PRED), IfW%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_SAVED_PRED), IfW%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_SAVED_PRED), IfW%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL InflowWind_CopyContState (IfW%x( STATE_SAVED_CURR), IfW%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_SAVED_CURR), IfW%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_SAVED_CURR), IfW%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_SAVED_CURR), IfW%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompInflow == Module_IfW - - - IF ( p_FAST%CompHydro == Module_HD ) THEN - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - HD%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - !HD_OutputTimes(i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL HydroDyn_CopyInput (HD%Input_Saved(j), HD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL HydroDyn_CopyContState (HD%x( STATE_SAVED_PRED), HD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyDiscState (HD%xd(STATE_SAVED_PRED), HD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyConstrState (HD%z( STATE_SAVED_PRED), HD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_SAVED_PRED), HD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL HydroDyn_CopyContState (HD%x( STATE_SAVED_CURR), HD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyDiscState (HD%xd(STATE_SAVED_CURR), HD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyConstrState (HD%z( STATE_SAVED_CURR), HD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_SAVED_CURR), HD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF !CompHydro - - - IF (p_FAST%CompSub == Module_SD ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - SD%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - !SD_OutputTimes(i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL SD_CopyInput (SD%Input_Saved(j), SD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL SD_CopyContState (SD%x( STATE_SAVED_PRED), SD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyDiscState (SD%xd(STATE_SAVED_PRED), SD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyConstrState (SD%z( STATE_SAVED_PRED), SD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyOtherState (SD%OtherSt(STATE_SAVED_PRED), SD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL SD_CopyContState (SD%x( STATE_SAVED_CURR), SD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyDiscState (SD%xd(STATE_SAVED_CURR), SD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyConstrState (SD%z( STATE_SAVED_CURR), SD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyOtherState (SD%OtherSt(STATE_SAVED_CURR), SD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSE IF (p_FAST%CompSub == Module_ExtPtfm ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - ExtPtfm%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL ExtPtfm_CopyInput (ExtPtfm%Input_Saved(j), ExtPtfm%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_SAVED_PRED), ExtPtfm%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_SAVED_PRED), ExtPtfm%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_SAVED_PRED), ExtPtfm%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_SAVED_PRED), ExtPtfm%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_SAVED_CURR), ExtPtfm%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_SAVED_CURR), ExtPtfm%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_SAVED_CURR), ExtPtfm%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_SAVED_CURR), ExtPtfm%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompSub - - - IF (p_FAST%CompMooring == Module_MAP) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - MAPp%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - !MAP_OutputTimes(i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL MAP_CopyInput (MAPp%Input_Saved(j), MAPp%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL MAP_CopyContState (MAPp%x( STATE_SAVED_PRED), MAPp%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyDiscState (MAPp%xd(STATE_SAVED_PRED), MAPp%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyConstrState (MAPp%z( STATE_SAVED_PRED), MAPp%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_SAVED_PRED), MAPp%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL MAP_CopyContState (MAPp%x( STATE_SAVED_CURR), MAPp%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyDiscState (MAPp%xd(STATE_SAVED_CURR), MAPp%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyConstrState (MAPp%z( STATE_SAVED_CURR), MAPp%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_SAVED_CURR), MAPp%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompMooring == Module_MD) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - MD%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - !MD_OutputTimes(i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL MD_CopyInput (MD%Input_Saved(j), MD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL MD_CopyContState (MD%x( STATE_SAVED_PRED), MD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyDiscState (MD%xd(STATE_SAVED_PRED), MD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyConstrState (MD%z( STATE_SAVED_PRED), MD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyOtherState (MD%OtherSt(STATE_SAVED_PRED), MD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL MD_CopyContState (MD%x( STATE_SAVED_CURR), MD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyDiscState (MD%xd(STATE_SAVED_CURR), MD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyConstrState (MD%z( STATE_SAVED_CURR), MD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyOtherState (MD%OtherSt(STATE_SAVED_CURR), MD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - FEAM%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - !FEAM_OutputTimes(i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL FEAM_CopyInput (FEAM%Input_Saved(j), FEAM%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL FEAM_CopyContState (FEAM%x( STATE_SAVED_PRED), FEAM%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyDiscState (FEAM%xd(STATE_SAVED_PRED), FEAM%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyConstrState (FEAM%z( STATE_SAVED_PRED), FEAM%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_SAVED_PRED), FEAM%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL FEAM_CopyContState (FEAM%x( STATE_SAVED_CURR), FEAM%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyDiscState (FEAM%xd(STATE_SAVED_CURR), FEAM%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyConstrState (FEAM%z( STATE_SAVED_CURR), FEAM%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_SAVED_CURR), FEAM%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompMooring == Module_Orca) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - Orca%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL Orca_CopyInput (Orca%Input_Saved(j), Orca%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL Orca_CopyContState (Orca%x( STATE_SAVED_PRED), Orca%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyDiscState (Orca%xd(STATE_SAVED_PRED), Orca%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyConstrState (Orca%z( STATE_SAVED_PRED), Orca%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyOtherState (Orca%OtherSt( STATE_SAVED_PRED), Orca%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL Orca_CopyContState (Orca%x( STATE_SAVED_CURR), Orca%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyDiscState (Orca%xd(STATE_SAVED_CURR), Orca%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyConstrState (Orca%z( STATE_SAVED_CURR), Orca%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyOtherState (Orca%OtherSt( STATE_SAVED_CURR), Orca%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompMooring - - - IF (p_FAST%CompIce == Module_IceF ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - IceF%InputTimes(j) = t_global - (j - 1) * p_FAST%dt - !IceF_OutputTimes(i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL IceFloe_CopyInput (IceF%Input_Saved(j), IceF%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL IceFloe_CopyContState (IceF%x( STATE_SAVED_PRED), IceF%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyDiscState (IceF%xd(STATE_SAVED_PRED), IceF%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyConstrState (IceF%z( STATE_SAVED_PRED), IceF%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_SAVED_PRED), IceF%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL IceFloe_CopyContState (IceF%x( STATE_SAVED_CURR), IceF%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyDiscState (IceF%xd(STATE_SAVED_CURR), IceF%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyConstrState (IceF%z( STATE_SAVED_CURR), IceF%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_SAVED_CURR), IceF%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompIce == Module_IceD ) THEN - - DO i = 1,p_FAST%numIceLegs - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - IceD%InputTimes(j,i) = t_global - (j - 1) * p_FAST%dt - !IceD%OutputTimes(j,i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL IceD_CopyInput (IceD%Input_Saved(j,i), IceD%Input(j,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL IceD_CopyContState (IceD%x( i,STATE_SAVED_PRED), IceD%x( i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyDiscState (IceD%xd(i,STATE_SAVED_PRED), IceD%xd(i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyConstrState (IceD%z( i,STATE_SAVED_PRED), IceD%z( i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_SAVED_PRED), IceD%OtherSt( i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL IceD_CopyContState (IceD%x( i,STATE_SAVED_CURR), IceD%x( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyDiscState (IceD%xd(i,STATE_SAVED_CURR), IceD%xd(i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyConstrState (IceD%z( i,STATE_SAVED_CURR), IceD%z( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_SAVED_CURR), IceD%OtherSt( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END DO ! numIceLegs - - END IF ! CompIce - - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! We've moved everything back to the initial time step: - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! update the global time - - m_FAST%t_global = t_global -! y_FAST%n_Out = y_FAST%n_Out - n_timesteps - -END SUBROUTINE FAST_Reset_SubStep -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls FAST_Store_SubStep 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. -SUBROUTINE FAST_Store_SubStep_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - CALL FAST_Store_SubStep(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) - -END SUBROUTINE FAST_Store_SubStep_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine resets the states, inputs and output data from n_t_global to n_t_global - 1 -SUBROUTINE FAST_Store_SubStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) - - USE BladedInterface, ONLY: CallBladedDLL ! Hack for Bladed-style DLL - - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - - 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(ExternalInflow_Data), INTENT(INOUT) :: ExtInfw !< ExternalInflow 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 - - 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, j, k ! generic loop counters - REAL(DbKi) :: t_global ! the time to which states, inputs and outputs are reset - INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Store_SubStep' - - - ErrStat = ErrID_None - ErrMsg = "" - - - t_global = t_initial + n_t_global * p_FAST%DT - - !---------------------------------------------------------------------------------------- - !! copy the stored states and inputs from n_t_global the current states and inputs - !---------------------------------------------------------------------------------------- - - DO j = 1, p_FAST%InterpOrder + 1 - ED%InputTimes_Saved(j) = ED%InputTimes(j) - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL ED_CopyInput (ED%Input(j), ED%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL ED_CopyOutput (ED%y, ED%Output_bak(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - - ! ElastoDyn: copy final predictions to actual states - CALL ED_CopyContState (ED%x( STATE_PRED), ED%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_PRED), ED%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_PRED), ED%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_PRED), ED%OtherSt( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ED_CopyContState (ED%x( STATE_CURR), ED%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_CURR), ED%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_CURR), ED%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), ED%OtherSt( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - IF (p_FAST%CompElast == Module_BD ) THEN - - DO k = 1,p_FAST%nBeams - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - BD%InputTimes_Saved(j,k) = BD%InputTimes(j,k) - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL BD_CopyInput (BD%Input(j,k), BD%Input_Saved(j,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL BD_CopyContState (BD%x( k,STATE_PRED), BD%x( k,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_PRED), BD%xd(k,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_PRED), BD%z( k,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_PRED), BD%OtherSt( k,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL BD_CopyContState (BD%x( k,STATE_CURR), BD%x( k,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_CURR), BD%xd(k,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_CURR), BD%z( k,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_CURR), BD%OtherSt( k,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - END IF - - IF ( p_FAST%CompServo == Module_SrvD ) THEN - ! Initialize Input-Output arrays for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - SrvD%InputTimes_Saved(j) = SrvD%InputTimes(j) - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL SrvD_CopyInput (SrvD%Input(j), SrvD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL SrvD_CopyContState (SrvD%x( STATE_PRED), SrvD%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyDiscState (SrvD%xd(STATE_PRED), SrvD%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyConstrState (SrvD%z( STATE_PRED), SrvD%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_PRED), SrvD%OtherSt( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL SrvD_CopyContState (SrvD%x( STATE_CURR), SrvD%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyDiscState (SrvD%xd(STATE_CURR), SrvD%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyConstrState (SrvD%z( STATE_CURR), SrvD%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_CURR), SrvD%OtherSt( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL SrvD_CopyMisc( SrvD%m, SrvD%m_bak, MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF - - IF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - AD%InputTimes_Saved(j) = AD%InputTimes(j) - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL AD_CopyInput (AD%Input(j), AD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL AD_CopyContState (AD%x( STATE_PRED), AD%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState (AD%xd(STATE_PRED), AD%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState (AD%z( STATE_PRED), AD%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState (AD%OtherSt(STATE_PRED), AD%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL AD_CopyContState (AD%x( STATE_CURR), AD%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState (AD%xd(STATE_CURR), AD%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState (AD%z( STATE_CURR), AD%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState (AD%OtherSt(STATE_CURR), AD%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompAero == Module_AD - - IF ( p_FAST%CompInflow == Module_IfW ) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - IfW%InputTimes_Saved(j) = IfW%InputTimes(j) - !IfW%OutputTimes(i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL InflowWind_CopyInput (IfW%Input(j), IfW%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL InflowWind_CopyContState (IfW%x( STATE_PRED), IfW%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_PRED), IfW%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_PRED), IfW%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_PRED), IfW%OtherSt( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL InflowWind_CopyContState (IfW%x( STATE_CURR), IfW%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_CURR), IfW%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_CURR), IfW%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_CURR), IfW%OtherSt( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompInflow == Module_IfW - - - IF ( p_FAST%CompHydro == Module_HD ) THEN - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - HD%InputTimes_Saved(j) = HD%InputTimes(j) - !HD_OutputTimes(i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL HydroDyn_CopyInput (HD%Input(j), HD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL HydroDyn_CopyContState (HD%x( STATE_PRED), HD%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyDiscState (HD%xd(STATE_PRED), HD%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyConstrState (HD%z( STATE_PRED), HD%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_PRED), HD%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL HydroDyn_CopyContState (HD%x( STATE_CURR), HD%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyDiscState (HD%xd(STATE_CURR), HD%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyConstrState (HD%z( STATE_CURR), HD%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_CURR), HD%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF !CompHydro - - - IF (p_FAST%CompSub == Module_SD ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - SD%InputTimes_Saved(j) = SD%InputTimes(j) - !SD_OutputTimes(i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL SD_CopyInput (SD%Input(j), SD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL SD_CopyContState (SD%x( STATE_PRED), SD%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyDiscState (SD%xd(STATE_PRED), SD%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyConstrState (SD%z( STATE_PRED), SD%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyOtherState (SD%OtherSt(STATE_PRED), SD%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL SD_CopyContState (SD%x( STATE_CURR), SD%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyDiscState (SD%xd(STATE_CURR), SD%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyConstrState (SD%z( STATE_CURR), SD%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyOtherState (SD%OtherSt(STATE_CURR), SD%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSE IF (p_FAST%CompSub == Module_ExtPtfm ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - ExtPtfm%InputTimes_Saved(j) = ExtPtfm%InputTimes(j) - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL ExtPtfm_CopyInput (ExtPtfm%Input(j), ExtPtfm%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_PRED), ExtPtfm%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_PRED), ExtPtfm%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_PRED), ExtPtfm%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_PRED), ExtPtfm%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_CURR), ExtPtfm%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_CURR), ExtPtfm%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_CURR), ExtPtfm%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompSub - - - IF (p_FAST%CompMooring == Module_MAP) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - MAPp%InputTimes_Saved(j) = MAPp%InputTimes(j) - !MAP_OutputTimes(i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL MAP_CopyInput (MAPp%Input(j), MAPp%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL MAP_CopyContState (MAPp%x( STATE_PRED), MAPp%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyDiscState (MAPp%xd(STATE_PRED), MAPp%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyConstrState (MAPp%z( STATE_PRED), MAPp%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_PRED), MAPp%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL MAP_CopyContState (MAPp%x( STATE_CURR), MAPp%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyDiscState (MAPp%xd(STATE_CURR), MAPp%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyConstrState (MAPp%z( STATE_CURR), MAPp%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_CURR), MAPp%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompMooring == Module_MD) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - MD%InputTimes_Saved(j) = MD%InputTimes(j) - !MD_OutputTimes(i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL MD_CopyInput (MD%Input(j), MD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL MD_CopyContState (MD%x( STATE_PRED), MD%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyDiscState (MD%xd(STATE_PRED), MD%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyConstrState (MD%z( STATE_PRED), MD%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyOtherState (MD%OtherSt(STATE_PRED), MD%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL MD_CopyContState (MD%x( STATE_CURR), MD%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyDiscState (MD%xd(STATE_CURR), MD%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyConstrState (MD%z( STATE_CURR), MD%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyOtherState (MD%OtherSt(STATE_CURR), MD%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - FEAM%InputTimes_Saved(j) = FEAM%InputTimes(j) - !FEAM_OutputTimes(i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL FEAM_CopyInput (FEAM%Input(j), FEAM%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL FEAM_CopyContState (FEAM%x( STATE_PRED), FEAM%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyDiscState (FEAM%xd(STATE_PRED), FEAM%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyConstrState (FEAM%z( STATE_PRED), FEAM%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_PRED), FEAM%OtherSt( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL FEAM_CopyContState (FEAM%x( STATE_CURR), FEAM%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyDiscState (FEAM%xd(STATE_CURR), FEAM%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyConstrState (FEAM%z( STATE_CURR), FEAM%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_CURR), FEAM%OtherSt( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompMooring == Module_Orca) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - Orca%InputTimes_Saved(j) = Orca%InputTimes(j) - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL Orca_CopyInput (Orca%Input(j), Orca%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL Orca_CopyContState (Orca%x( STATE_PRED), Orca%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyDiscState (Orca%xd(STATE_PRED), Orca%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyConstrState (Orca%z( STATE_PRED), Orca%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyOtherState (Orca%OtherSt( STATE_PRED), Orca%OtherSt( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL Orca_CopyContState (Orca%x( STATE_CURR), Orca%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyDiscState (Orca%xd(STATE_CURR), Orca%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyConstrState (Orca%z( STATE_CURR), Orca%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyOtherState (Orca%OtherSt( STATE_CURR), Orca%OtherSt( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! CompMooring - - - IF (p_FAST%CompIce == Module_IceF ) THEN - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - IceF%InputTimes_Saved(j) = IceF%InputTimes(j) - !IceF_OutputTimes(i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL IceFloe_CopyInput (IceF%Input(j), IceF%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL IceFloe_CopyContState (IceF%x( STATE_PRED), IceF%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyDiscState (IceF%xd(STATE_PRED), IceF%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyConstrState (IceF%z( STATE_PRED), IceF%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_PRED), IceF%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL IceFloe_CopyContState (IceF%x( STATE_CURR), IceF%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyDiscState (IceF%xd(STATE_CURR), IceF%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyConstrState (IceF%z( STATE_CURR), IceF%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_CURR), IceF%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF (p_FAST%CompIce == Module_IceD ) THEN - - DO i = 1,p_FAST%numIceLegs - - ! Copy values for interpolation/extrapolation: - DO j = 1, p_FAST%InterpOrder + 1 - IceD%InputTimes_Saved(j,i) = IceD%InputTimes(j,i) - !IceD%OutputTimes(j,i) = t_global - (j - 1) * dt - END DO - - DO j = 1, p_FAST%InterpOrder + 1 - CALL IceD_CopyInput (IceD%Input(j,i), IceD%Input_Saved(j,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - CALL IceD_CopyContState (IceD%x( i,STATE_PRED), IceD%x( i,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyDiscState (IceD%xd(i,STATE_PRED), IceD%xd(i,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyConstrState (IceD%z( i,STATE_PRED), IceD%z( i,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_PRED), IceD%OtherSt( i,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL IceD_CopyContState (IceD%x( i,STATE_CURR), IceD%x( i,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyDiscState (IceD%xd(i,STATE_CURR), IceD%xd(i,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyConstrState (IceD%z( i,STATE_CURR), IceD%z( i,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_CURR), IceD%OtherSt( i,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END DO ! numIceLegs - - END IF ! CompIce - - ! A hack to store Bladed-style DLL data - if (SrvD%p%UseBladedInterface) then - if (SrvD%m%dll_data%avrSWAP( 1) > 0 ) then ! this isn't allocated if UseBladedInterface is FALSE - ! store value to be overwritten - old_avrSwap1 = SrvD%m%dll_data%avrSWAP( 1) - SrvD%m%dll_data%avrSWAP( 1) = -11 - CALL CallBladedDLL(SrvD%Input(1), SrvD%p, SrvD%m%dll_data, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! put values back: - SrvD%m%dll_data%avrSWAP( 1) = old_avrSwap1 - end if - end if - -END SUBROUTINE FAST_Store_SubStep -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls FAST_Solution 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. -SUBROUTINE FAST_Solution_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - CALL FAST_Solution(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) - -END SUBROUTINE FAST_Solution_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine takes data from n_t_global and gets values at n_t_global + 1 -SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SC_DX, SeaSt, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - - 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(SED_Data), INTENT(INOUT) :: SED !< Simplified-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(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data - TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< External loads data - TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data - TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller Exchange data - TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState 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 - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Solution' - - ErrStat = ErrID_None - ErrMsg = "" - - n_t_global_next = n_t_global+1 - - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! ## Step 1.a: set some variables and Extrapolate Inputs - - call FAST_Prework(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SC_DX, & - SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! ## Step 1.b: Advance states (yield state and constraint values at t_global_next) - !! ## Step 1.c: Input-Output Solve - !! ## Step 2: Correct (continue in loop) - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - call FAST_UpdateStates(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SC_DX, & - SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! ## Step 3: Save all final variables (advance to next time) and reset global time - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - call FAST_AdvanceToNextTimeStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SC_DX, & - SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - - !---------------------------------------------------------------------------------------- - !! Write outputs - !---------------------------------------------------------------------------------------- - call FAST_WriteOutput(t_initial, n_t_global_next, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SC_DX, & - SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - -END SUBROUTINE FAST_Solution +END SUBROUTINE FAST_Solution_T !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that calls FAST_Prework for one instance of a Turbine data structure. This is a separate subroutine so that the FAST @@ -7456,529 +5176,98 @@ SUBROUTINE FAST_Prework_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - CALL FAST_Prework(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) - -END SUBROUTINE FAST_Prework_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine does thde prep work to advance the time step from n_t_global to n_t_global + 1 -SUBROUTINE FAST_Prework(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SC_DX, & - SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - - 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(SED_Data), INTENT(INOUT) :: SED !< Simplified-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(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data - TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< External loads data - TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data - TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller Exchange data - TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState 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 - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 - REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Prework' - - - ErrStat = ErrID_None - ErrMsg = "" - - 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 - - ! set flag for writing output at time t_global_next - 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 - - if (p_FAST%CompMooring == Module_Orca .and. n_t_global < 5) then - m_FAST%NextJacCalcTime = m_FAST%t_global + p_FAST%DT ! the jacobian calculated with OrcaFlex at t=0 is incorrect, but is okay on the 2nd step (it's not okay for OrcaFlex version 10, so I increased this to 5) - else - m_FAST%NextJacCalcTime = m_FAST%t_global + p_FAST%DT_UJac - end if - - END IF - - ! the ServoDyn inputs from Simulink are for t, not t+dt, so we're going to overwrite the inputs from - ! the previous step before we extrapolate these inputs: - IF ( p_FAST%CompServo == Module_SrvD ) CALL SrvD_SetExternalInputs( p_FAST, m_FAST, SrvD%Input(1) ) - - IF ( p_FAST%UseSC ) THEN - CALL SC_DX_SetOutputs(p_FAST, SrvD%Input(1), SC_DX, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! ## Step 1.a: Extrapolate Inputs - !! - !! gives predicted values at t+dt - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - CALL FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - -END SUBROUTINE FAST_Prework -!---------------------------------------------------------------------------------------------------------------------------------- -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls FAST_UpdateStates 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. -SUBROUTINE FAST_UpdateStates_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - CALL FAST_UpdateStates(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) - -END SUBROUTINE FAST_UpdateStates_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine takes data from n_t_global and predicts the states and output at n_t_global+1 -SUBROUTINE FAST_UpdateStates(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SC_DX, & - SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - - 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(SED_Data), INTENT(INOUT) :: SED !< Simplified-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(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data - TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< External loads data - TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data - TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller Exchange data - TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState 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 - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - REAL(DbKi) :: t_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 - - !REAL(ReKi) :: ControlInputGuess ! value of controller inputs - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UpdateStates' - - - 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 - - ! set number of corrections to be used for this time step: - IF ( p_FAST%CompElast == Module_BD ) THEN ! BD accelerations have fewer spikes with these corrections on the first several time steps - if (n_t_global > 2) then ! this 2 should probably be related to p_FAST%InterpOrder - NumCorrections = p_FAST%NumCrctn - elseif (n_t_global == 0) then - NumCorrections = max(p_FAST%NumCrctn,16) - else - NumCorrections = max(p_FAST%NumCrctn,1) - end if - ELSE - NumCorrections = p_FAST%NumCrctn - END IF - - !! predictor-corrector loop: - 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) - !! - !! STATE_CURR values of x, xd, z, and OtherSt contain values at m_FAST%t_global; - !! STATE_PRED values contain values at t_global_next. - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - CALL FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, 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, WriteThisStep, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, 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 - - if (p_FAST%UseSC ) then - call SC_DX_SetInputs(p_FAST, SrvD%y, SC_DX, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if - - if ( P_FAST%CompSeaSt == Module_SeaSt .and. y_FAST%WriteThisStep) then - ! note: SeaState has no inputs and only calculates WriteOutputs, so we don't need to call CalcOutput unless we are writing to the file - call SeaSt_CalcOutput( t_global_next, SeaSt%u, SeaSt%p, SeaSt%x(1), SeaSt%xd(1), SeaSt%z(1), SeaSt%OtherSt(1), SeaSt%y, SeaSt%m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if - -END SUBROUTINE FAST_UpdateStates - -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls FAST_AdvanceToNextTimeStep 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. -SUBROUTINE FAST_AdvanceToNextTimeStep_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - CALL FAST_AdvanceToNextTimeStep(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) - -END SUBROUTINE FAST_AdvanceToNextTimeStep_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine advances the time step from n_t_global to n_t_global + 1 and does all the relvant copying of data -SUBROUTINE FAST_AdvanceToNextTimeStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SC_DX, & - SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - - 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(SED_Data), INTENT(INOUT) :: SED !< Simplified-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(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data - TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< External loads data - TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data - TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller Exchange data - TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState 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 - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) - INTEGER(IntKi) :: I, k ! generic loop counters - INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_AdvanceToNextTimeStep' - + INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 + REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) + INTEGER(IntKi) :: i ErrStat = ErrID_None ErrMsg = "" - t_global_next = t_initial + (n_t_global+1)*p_FAST%DT ! = m_FAST%t_global + p_FAST%dt - - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! ## Step 3: Save all final variables (advance to next time) - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - !---------------------------------------------------------------------------------------- - !! copy the final predicted states from step t_global_next to actual states for that step - !---------------------------------------------------------------------------------------- - - IF ( p_FAST%CompElast == Module_SED ) THEN - ! Simplified-ElastoDyn: copy final predictions to actual states - CALL SED_CopyContState (SED%x( STATE_PRED), SED%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SED_CopyDiscState (SED%xd(STATE_PRED), SED%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SED_CopyConstrState (SED%z( STATE_PRED), SED%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SED_CopyOtherState (SED%OtherSt( STATE_PRED), SED%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSE - ! ElastoDyn: copy final predictions to actual states - CALL ED_CopyContState (ED%x( STATE_PRED), ED%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_PRED), ED%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_PRED), ED%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_PRED), ED%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ENDIF - - - ! BeamDyn: copy final predictions to actual states - IF ( p_FAST%CompElast == Module_BD ) THEN - DO k=1,p_FAST%nBeams - CALL BD_CopyContState (BD%x( k,STATE_PRED), BD%x( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_PRED), BD%xd(k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_PRED), BD%z( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_PRED), BD%OtherSt( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - END IF + n_t_global_next = n_t_global + 1 + t_global_next = t_initial + n_t_global_next * Turbine%p_FAST%DT + ! Set flag for writing output at time t_global_next + Turbine%y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_global_next, Turbine%p_FAST) - ! AeroDyn: copy final predictions to actual states; copy current outputs to next - IF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN - CALL AD_CopyContState (AD%x( STATE_PRED), AD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState (AD%xd(STATE_PRED), AD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState (AD%z( STATE_PRED), AD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState (AD%OtherSt(STATE_PRED), AD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSEIF ( p_FAST%CompAero == Module_ADsk ) THEN - CALL ADsk_CopyContState (ADsk%x( STATE_PRED), ADsk%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ADsk_CopyDiscState (ADsk%xd(STATE_PRED), ADsk%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ADsk_CopyConstrState (ADsk%z( STATE_PRED), ADsk%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ADsk_CopyOtherState (ADsk%OtherSt(STATE_PRED), ADsk%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF + ! the ServoDyn inputs from Simulink are for t, not t+dt, so we're going to overwrite the inputs from + ! the previous step before we extrapolate these inputs: + if (Turbine%p_FAST%CompServo == Module_SrvD) call SrvD_SetExternalInputs(Turbine%p_FAST, Turbine%m_FAST, Turbine%SrvD%Input(1)) + if (Turbine%p_FAST%UseSC) THEN + call SC_DX_SetOutputs(Turbine%p_FAST, Turbine%SrvD%Input(1), Turbine%SC_DX, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END if - ! InflowWind: copy final predictions to actual states; copy current outputs to next - IF ( p_FAST%CompInflow == Module_IfW ) THEN - CALL InflowWind_CopyContState (IfW%x( STATE_PRED), IfW%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_PRED), IfW%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_PRED), IfW%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_PRED), IfW%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! ## Step 1.a: Extrapolate Inputs + !! + !! gives predicted values at t+dt + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + do i = 1, size(Turbine%m_Glue%ModData) + call FAST_ExtrapInterp(Turbine%m_Glue%ModData(i), t_global_next, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do - ! ServoDyn: copy final predictions to actual states; copy current outputs to next - IF ( p_FAST%CompServo == Module_SrvD ) THEN - CALL SrvD_CopyContState (SrvD%x( STATE_PRED), SrvD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyDiscState (SrvD%xd(STATE_PRED), SrvD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyConstrState (SrvD%z( STATE_PRED), SrvD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_PRED), SrvD%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF +contains - ! SeaState has no states - ! HydroDyn: copy final predictions to actual states - IF ( p_FAST%CompHydro == Module_HD ) THEN - CALL HydroDyn_CopyContState (HD%x( STATE_PRED), HD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyDiscState (HD%xd(STATE_PRED), HD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyConstrState (HD%z( STATE_PRED), HD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_PRED), HD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF +END SUBROUTINE FAST_Prework_T +!---------------------------------------------------------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_UpdateStates 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. +SUBROUTINE FAST_UpdateStates_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - ! SubDyn: copy final predictions to actual states - IF ( p_FAST%CompSub == Module_SD ) THEN - CALL SD_CopyContState (SD%x( STATE_PRED), SD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyDiscState (SD%xd(STATE_PRED), SD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyConstrState (SD%z( STATE_PRED), SD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyOtherState (SD%OtherSt(STATE_PRED), SD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN - CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_PRED), ExtPtfm%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_PRED), ExtPtfm%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_PRED), ExtPtfm%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_PRED), ExtPtfm%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UpdateStates' + INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 + REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) + ErrStat = ErrID_None + ErrMsg = "" - ! MAP: copy final predictions to actual states - IF (p_FAST%CompMooring == Module_MAP) THEN - CALL MAP_CopyContState (MAPp%x( STATE_PRED), MAPp%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyDiscState (MAPp%xd(STATE_PRED), MAPp%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyConstrState (MAPp%z( STATE_PRED), MAPp%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_PRED), MAPp%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSEIF (p_FAST%CompMooring == Module_MD) THEN - CALL MD_CopyContState (MD%x( STATE_PRED), MD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyDiscState (MD%xd(STATE_PRED), MD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyConstrState (MD%z( STATE_PRED), MD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyOtherState (MD%OtherSt(STATE_PRED), MD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN - CALL FEAM_CopyContState (FEAM%x( STATE_PRED), FEAM%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyDiscState (FEAM%xd(STATE_PRED), FEAM%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyConstrState (FEAM%z( STATE_PRED), FEAM%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_PRED), FEAM%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSEIF (p_FAST%CompMooring == Module_Orca) THEN - CALL Orca_CopyContState (Orca%x( STATE_PRED), Orca%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyDiscState (Orca%xd(STATE_PRED), Orca%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyConstrState (Orca%z( STATE_PRED), Orca%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyOtherState (Orca%OtherSt( STATE_PRED), Orca%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF + ! Calculate time + n_t_global_next = n_t_global + 1 + t_global_next = t_initial + n_t_global_next*Turbine%p_FAST%DT - ! IceFloe: copy final predictions to actual states - IF ( p_FAST%CompIce == Module_IceF ) THEN - CALL IceFloe_CopyContState (IceF%x( STATE_PRED), IceF%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyDiscState (IceF%xd(STATE_PRED), IceF%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyConstrState (IceF%z( STATE_PRED), IceF%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_PRED), IceF%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN - DO i=1,p_FAST%numIceLegs - CALL IceD_CopyContState (IceD%x( i,STATE_PRED), IceD%x( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyDiscState (IceD%xd(i,STATE_PRED), IceD%xd(i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyConstrState (IceD%z( i,STATE_PRED), IceD%z( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_PRED), IceD%OtherSt( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - END IF + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! Solver Step + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + ! Advance simulation one step and calculate outputs + CALL FAST_SolverStep(n_t_global, t_initial, Turbine%p_Glue%TC, Turbine%m_Glue%TC, & + Turbine%m_Glue%ModData, Turbine%m_Glue%Mappings, Turbine, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! We've advanced everything to the next time step: + !! SuperController !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! update the global time + if (Turbine%p_FAST%UseSC) then + call SC_DX_SetInputs(Turbine%p_FAST, Turbine%SrvD%y, Turbine%SC_DX, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if + +END SUBROUTINE FAST_UpdateStates_T - m_FAST%t_global = t_global_next -END SUBROUTINE FAST_AdvanceToNextTimeStep !---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls FAST_WriteOutput for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!> Routine that calls FAST_AdvanceToNextTimeStep 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. -SUBROUTINE FAST_WriteOutput_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) +SUBROUTINE FAST_AdvanceToNextTimeStep_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial time INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter @@ -7986,80 +5275,86 @@ SUBROUTINE FAST_WriteOutput_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - CALL FAST_WriteOutput(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_AdvanceToNextTimeStep' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) + INTEGER(IntKi) :: i -END SUBROUTINE FAST_WriteOutput_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine writes the outputs at this timestep -SUBROUTINE FAST_WriteOutput(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SC_DX, & - SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + ErrStat = ErrID_None + ErrMsg = "" - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! ## Step 3: Save all final variables (advance to next 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 + ! Copy solver predicted state to current state + call Glue_CopyTC_State(Turbine%m_Glue%TC%StatePred, Turbine%m_Glue%TC%StateCurr, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return - TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data - TYPE(SED_Data), INTENT(IN ) :: SED !< Simplified-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(AeroDisk_Data), INTENT(IN ) :: ADsk !< AeroDisk data - TYPE(ExtLoads_Data), INTENT(IN ) :: ExtLd !< External loads data - TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data - TYPE(ExternalInflow_Data),INTENT(IN ) :: ExtInfw !< ExternalInflow data - TYPE(SCDataEx_Data), INTENT(IN ) :: SC_DX !< Supercontroller Exchange data - TYPE(SeaState_Data), INTENT(IN ) :: SeaSt !< SeaState 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 !< Data for the MoorDyn module - 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 + ! Copy the final predicted states from step t_global_next to actual states for that step + do i = 1, size(Turbine%m_Glue%ModData) + call FAST_CopyStates(Turbine%m_Glue%ModData(i), Turbine, STATE_PRED, STATE_CURR, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do - TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! We've advanced everything to the next time step: + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !! update the global time + t_global_next = n_t_global+1 + Turbine%m_FAST%t_global = t_initial + t_global_next * Turbine%p_FAST%DT + +END SUBROUTINE FAST_AdvanceToNextTimeStep_T + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_WriteOutput 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. +SUBROUTINE FAST_WriteOutput_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t_global ! this simulation time (m_FAST%t_global + p_FAST%dt) + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_WriteOutput' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_WriteOutput' - + REAL(DbKi) :: t_global ! this simulation time (m_FAST%t_global + p_FAST%dt) ErrStat = ErrID_None ErrMsg = "" - t_global = t_initial + n_t_global*p_FAST%DT + ! Calculate current time + t_global = t_initial + n_t_global*Turbine%p_FAST%DT - !---------------------------------------------------------------------------------------- - !! Check to see if we should output data this time step: - !---------------------------------------------------------------------------------------- - CALL WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, SED, BD, AD, ADsk, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & - SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !---------------------------------------------------------------------------- + !! Write output (subroutine checks y_FAST%WriteThisStep internally) + !---------------------------------------------------------------------------- + + call WriteOutputToFile(n_t_global, t_global, Turbine%p_FAST, Turbine%y_FAST, & + Turbine%ED, Turbine%SED, Turbine%BD, Turbine%AD, Turbine%ADsk, Turbine%IfW, Turbine%ExtInfw, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, & + Turbine%SrvD, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - !---------------------------------------------------------------------------------------- + !---------------------------------------------------------------------------- !! Display simulation status every SttsTime-seconds (i.e., n_SttsTime steps): - !---------------------------------------------------------------------------------------- + !---------------------------------------------------------------------------- - IF (p_FAST%WrSttsTime) then - IF ( MOD( n_t_global, 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 + if (Turbine%p_FAST%WrSttsTime) then + if (MOD(n_t_global, Turbine%p_FAST%n_SttsTime ) == 0) then + call SimStatus(Turbine%m_FAST%TiLstPrn, Turbine%m_FAST%PrevClockTime, & + Turbine%m_FAST%t_global, Turbine%p_FAST%TMax, Turbine%p_FAST%TDesc) + end if + end if -END SUBROUTINE FAST_WriteOutput +END SUBROUTINE FAST_WriteOutput_T !---------------------------------------------------------------------------------------------------------------------------------- ! ROUTINES TO OUTPUT WRITE DATA TO FILE AT EACH REQUSTED TIME STEP @@ -8125,7 +5420,7 @@ SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, SED, BD, IF ( y_FAST%WriteThisStep ) THEN ! Generate glue-code output file - CALL WrOutputLine( t_global, p_FAST, y_FAST, IfW%y%WriteOutput, ExtInfw%y%WriteOutput, ED%y%WriteOutput, SED%y%WriteOutput, & + CALL WrOutputLine( t_global, p_FAST, y_FAST, IfW%y%WriteOutput, ExtInfw%y%WriteOutput, ED%y, SED%y%WriteOutput, & AD%y, ADsk%y%WriteOutput, SrvD%y%WriteOutput, SeaSt%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 ) @@ -8142,7 +5437,7 @@ SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, SED, BD, END SUBROUTINE WriteOutputToFile !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes the module output to the primary output file(s). -SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, SEDOutput, y_AD, ADskOutput, SrvDOutput, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput,& +SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, ExtInfwOutput, y_ED, SEDOutput, y_AD, ADskOutput, SrvDOutput, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput,& MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, ErrStat, ErrMsg) IMPLICIT NONE @@ -8155,7 +5450,7 @@ SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, REAL(ReKi), ALLOCATABLE, INTENT(IN) :: IfWOutput (:) !< InflowWind WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: ExtInfwOutput (:) !< ExternalInflow WriteOutput values - REAL(ReKi), ALLOCATABLE, INTENT(IN) :: EDOutput (:) !< ElastoDyn WriteOutput values + TYPE(ED_OutputType), INTENT(IN) :: y_ED (:) !< ElastoDyn WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: SEDOutput (:) !< Simplified-ElastoDyn WriteOutput values TYPE(AD_OutputType), INTENT(IN) :: y_AD !< AeroDyn outputs (WriteOutput values are subset of allocated Rotors) REAL(ReKi), ALLOCATABLE, INTENT(IN) :: ADskOutput (:) !< AeroDisk WriteOutput values @@ -8185,7 +5480,7 @@ SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, ErrStat = ErrID_None ErrMsg = '' - CALL FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, SEDOutput, y_AD, ADskOutput, SrvDOutput, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput, & + CALL FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, y_ED, SEDOutput, y_AD, ADskOutput, SrvDOutput, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput, & MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, OutputAry) IF (p_FAST%WrTxtOutFile) THEN @@ -8245,7 +5540,7 @@ SUBROUTINE FillOutputAry_T(Turbine, Outputs) CALL FillOutputAry(Turbine%p_FAST, Turbine%y_FAST, Turbine%IfW%y%WriteOutput, Turbine%ExtInfw%y%WriteOutput, & - Turbine%ED%y%WriteOutput, Turbine%SED%y%WriteOutput, Turbine%AD%y, Turbine%ADsk%y%WriteOutput, Turbine%SrvD%y%WriteOutput, & + Turbine%ED%y, Turbine%SED%y%WriteOutput, Turbine%AD%y, Turbine%ADsk%y%WriteOutput, Turbine%SrvD%y%WriteOutput, & Turbine%SeaSt%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) @@ -8254,7 +5549,7 @@ END SUBROUTINE FillOutputAry_T !---------------------------------------------------------------------------------------------------------------------------------- !> This routine concatenates all of the WriteOutput values from the module Output into one array to be written to the FAST !! output file. -SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, SEDOutput, y_AD, ADskOutput, SrvDOutput, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput, & +SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, y_ED, SEDOutput, y_AD, ADskOutput, SrvDOutput, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput, & MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, OutputAry) TYPE(FAST_ParameterType), INTENT(IN) :: p_FAST !< Glue-code simulation parameters @@ -8262,7 +5557,7 @@ SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, SED REAL(ReKi), ALLOCATABLE, INTENT(IN) :: IfWOutput (:) !< InflowWind WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: ExtInfwOutput (:) !< ExternalInflow WriteOutput values - REAL(ReKi), ALLOCATABLE, INTENT(IN) :: EDOutput (:) !< ElastoDyn WriteOutput values + TYPE(ED_OutputType), INTENT(IN) :: y_ED (:) !< ElastoDyn WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: SEDOutput (:) !< Simplified-ElastoDyn WriteOutput values TYPE(AD_OutputType), INTENT(IN) :: y_AD !< AeroDyn outputs (WriteOutput values are subset of allocated Rotors) REAL(ReKi), ALLOCATABLE, INTENT(IN) :: ADskOutput (:) !< AeroDisk WriteOutput values @@ -8292,8 +5587,8 @@ SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, SED indxNext = 1 IF (y_FAST%numOuts(Module_Glue) > 1) THEN ! if we output more than just the time channel.... - indxLast = indxNext + SIZE(y_FAST%DriverWriteOutput) - 1 - OutputAry(indxNext:indxLast) = y_FAST%DriverWriteOutput + indxLast = y_FAST%numOuts(Module_Glue) - 1 + OutputAry(indxNext:indxLast) = y_FAST%DriverWriteOutput(1:y_FAST%numOuts(Module_Glue)-1) indxNext = IndxLast + 1 END IF @@ -8308,9 +5603,11 @@ SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, SED END IF IF ( y_FAST%numOuts(Module_ED) > 0 ) THEN - indxLast = indxNext + SIZE(EDOutput) - 1 - OutputAry(indxNext:indxLast) = EDOutput - indxNext = IndxLast + 1 + do i=1,SIZE(y_ED) + indxLast = indxNext + SIZE(y_ED(i)%WriteOutput) - 1 + OutputAry(indxNext:indxLast) = y_ED(i)%WriteOutput + indxNext = IndxLast + 1 + end do END IF IF ( y_FAST%numOuts(Module_SED) > 0 ) THEN @@ -8441,7 +5738,7 @@ SUBROUTINE WriteVTK(t_global, p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) ELSE IF (p_FAST%VTK_Type==VTK_Old) THEN if (p_FAST%CompElast /= Module_SED) then !FIXME: SED is not included in these routines!!!! - 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 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') endif !unOut = -1 @@ -8482,8 +5779,7 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, Ex ! logical :: outputFields ! flag to determine if we want to output the HD mesh fields - INTEGER(IntKi) :: NumBl, k - INTEGER(IntKi) :: j ! counter for StC instance at location + INTEGER(IntKi) :: NumBl, k, j INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 @@ -8492,8 +5788,8 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, Ex NumBl = 0 - if (allocated(ED%y%BladeRootMotion)) then - NumBl = SIZE(ED%y%BladeRootMotion) + if (allocated(ED%y(iED)%BladeRootMotion)) then + NumBl = SIZE(ED%y(iED)%BladeRootMotion) elseif (allocated(SED%y%BladeRootMotion)) then NumBl = SIZE(SED%y%BladeRootMotion) end if @@ -8508,10 +5804,10 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, Ex ! ElastoDyn outputs (motions) DO K=1,NumBl !%BladeLn2Mesh(K) used only when not BD (see below) - 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 ) + call MeshWrVTK(p_FAST%TurbinePos, ED%y(iED)%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%y%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_TowerLn2Mesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, ED%y(iED)%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%y%HubPtMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_HubPtMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) @@ -8520,11 +5816,13 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, Ex ! ElastoDyn inputs (loads) ! %BladePtLoads used only when not BD (see below) - 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)%TFinCMLoads, trim(p_FAST%VTK_OutFileRoot)//'.ED_TailFin' ,y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%TFinCMMotion ) - 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 ) + do j = 1, size(ED%Input,2) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1,j)%TowerPtLoads, trim(p_FAST%VTK_OutFileRoot)//'.ED_TowerPtLoads'//Num2LStr(j), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y(j)%TowerLn2Mesh ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1,j)%HubPtLoad, trim(p_FAST%VTK_OutFileRoot)//'.ED_Hub'//Num2LStr(j), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y(j)%HubPtMotion ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1,j)%NacelleLoads, trim(p_FAST%VTK_OutFileRoot)//'.ED_Nacelle'//Num2LStr(j) ,y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y(j)%NacelleMotion ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1,j)%TFinCMLoads, trim(p_FAST%VTK_OutFileRoot)//'.ED_TailFin'//Num2LStr(j) ,y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y(j)%TFinCMMotion ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1,j)%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_PlatformPtMesh'//Num2LStr(j), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y(j)%PlatformPtMesh ) + end do end if @@ -8563,9 +5861,11 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, Ex ELSE if (p_FAST%CompElast == Module_ED .and. allocated(ED%Input)) then ! ElastoDyn - DO K=1,NumBl - 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) ) + DO j = 1, size(ED%y) + DO K = 1, size(ED%y(j)%BladeLn2Mesh) + call MeshWrVTK(p_FAST%TurbinePos, ED%y(j)%BladeLn2Mesh(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladeLn2Mesh_motion'//trim(num2lstr(j))//'-'//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,j)%BladePtLoads(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladePtLoads'//trim(num2lstr(j))//'-'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y(j)%BladeLn2Mesh(K) ) + END DO END DO ELSE if (p_FAST%CompElast == Module_SED .and. allocated(SED%Input)) then ! Simplified-ElastoDyn @@ -8770,8 +6070,8 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, NumBl = 0 - if (allocated(ED%y%BladeRootMotion)) then - NumBl = SIZE(ED%y%BladeRootMotion) + if (allocated(ED%y(iED)%BladeRootMotion)) then + NumBl = SIZE(ED%y(iED)%BladeRootMotion) elseif (allocated(SED%y%BladeRootMotion)) then NumBl = SIZE(SED%y%BladeRootMotion) end if @@ -8791,13 +6091,14 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) END DO ELSE IF ( p_FAST%CompElast == Module_ED ) THEN - DO K=1,NumBl - 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 + do j = 1, size(ED%y) + DO k = 1, size(ED%y(j)%BladeLn2Mesh) + call MeshWrVTK(p_FAST%TurbinePos, ED%y(j)%BladeLn2Mesh(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladeLn2Mesh_motion'//trim(num2lstr(j))//'-'//trim(num2lstr(k)), & + y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + END DO + end do END IF -! Nacelle if (p_FAST%CompElast == Module_SED) then if (allocated(SED%Input)) then ! Nacelle @@ -8812,18 +6113,20 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, end if else if (allocated(ED%Input)) then - ! 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 ) - ! TailFin - call MeshWrVTK(p_FAST%TurbinePos, ED%y%TFinCMMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_TailFin', y_FAST%VTK_count, & - p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=ED%Input(1)%TFinCMLoads ) - ! 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%y%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_TowerLn2Mesh_motion', & - y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + do j = 1, size(ED%y) + ! Nacelle + call MeshWrVTK(p_FAST%TurbinePos, ED%y(j)%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_Nacelle'//Num2LStr(j), y_FAST%VTK_count, & + p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=ED%Input(1,j)%NacelleLoads ) + ! TailFin + call MeshWrVTK(p_FAST%TurbinePos, ED%y(j)%TFinCMMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_TailFin'//Num2LStr(j), y_FAST%VTK_count, & + p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=ED%Input(1,j)%TFinCMLoads ) + ! Hub + call MeshWrVTK(p_FAST%TurbinePos, ED%y(j)%HubPtMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_Hub'//Num2LStr(j), y_FAST%VTK_count, & + p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=ED%Input(1,j)%HubPtLoad ) + ! Tower motions + call MeshWrVTK(p_FAST%TurbinePos, ED%y(j)%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_TowerLn2Mesh_motion'//Num2LStr(j), & + y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + end do end if endif @@ -8904,14 +6207,14 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD 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, L + INTEGER(IntKi) :: NumBl, j, k, L INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 CHARACTER(*), PARAMETER :: RoutineName = 'WrVTK_Surfaces' NumBl = 0 - if (allocated(ED%y%BladeRootMotion)) then - NumBl = SIZE(ED%y%BladeRootMotion) + if (allocated(ED%y(iED)%BladeRootMotion)) then + NumBl = SIZE(ED%y(iED)%BladeRootMotion) elseif (allocated(SED%y%BladeRootMotion)) then NumBl = SIZE(SED%y%BladeRootMotion) end if @@ -8922,21 +6225,24 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD if ( allocated( p_FAST%VTK_Surface%WaveElevVisGrid ) ) call WrVTK_WaveElevVisGrid( t_global, p_FAST, y_FAST, SeaSt) if (allocated(ED%Input)) then - ! Nacelle - 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 ) - ! TailFin TODO TailFin - !call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%y%TFinCMMotion, trim(p_FAST%VTK_OutFileRoot)//'.TailFinSurface', & - ! y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts = p_FAST%VTK_Surface%TFinBox, Sib=ED%Input(1)%TFinCMLoads ) - - ! Hub - 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 ) + do j = 1, size(ED%Input,2) + ! Nacelle + call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%y(j)%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//'.NacelleSurface'//Num2LStr(j), & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts = p_FAST%VTK_Surface%NacelleBox, Sib=ED%Input(1,j)%NacelleLoads ) + + ! TailFin TODO TailFin + !call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%y(j)%TFinCMMotion, trim(p_FAST%VTK_OutFileRoot)//'.TailFinSurface'//Num2LStr(j), & + ! y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts = p_FAST%VTK_Surface%TFinBox, Sib=ED%Input(1,j)%TFinCMLoads ) + + ! Hub + call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%y(j)%HubPtMotion, trim(p_FAST%VTK_OutFileRoot)//'.HubSurface'//Num2LStr(j), & + 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,j)%HubPtLoad ) + + ! Tower motions + call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, ED%y(j)%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.TowerSurface'//Num2LStr(j), & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, p_FAST%VTK_Surface%NumSectors, p_FAST%VTK_Surface%TowerRad ) + end do end if ! Blades @@ -8954,10 +6260,12 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords ) END DO ELSE IF ( p_FAST%CompElast == Module_ED ) THEN - DO K=1,NumBl - 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 + do j = 1, size(ED%y) + DO k = 1, size(ED%y(j)%BladeLn2Mesh) + call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, ED%y(j)%BladeLn2Mesh(K), trim(p_FAST%VTK_OutFileRoot)//'.ED'//trim(Num2LStr(j))//'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 do ! ELSE IF ( p_FAST%CompElast == Module_SED ) THEN ! No surface info from SED END IF @@ -9177,7 +6485,7 @@ END SUBROUTINE GetWaveElevIndx !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes Input Mesh information to a binary file (for debugging). It both opens and closes the file. SUBROUTINE WriteInputMeshesToFile(u_ED, u_AD, u_SD, u_HD, u_MAP, u_BD, FileName, ErrStat, ErrMsg) - TYPE(ED_InputType), INTENT(IN) :: u_ED !< ElastoDyn inputs + TYPE(ED_InputType), INTENT(IN) :: u_ED(:) !< ElastoDyn inputs TYPE(AD_InputType), INTENT(IN) :: u_AD !< AeroDyn inputs TYPE(SD_InputType), INTENT(IN) :: u_SD !< SubDyn inputs TYPE(HydroDyn_InputType), INTENT(IN) :: u_HD !< HydroDyn inputs @@ -9188,7 +6496,7 @@ SUBROUTINE WriteInputMeshesToFile(u_ED, u_AD, u_SD, u_HD, u_MAP, u_BD, FileName, CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None INTEGER(IntKi) :: unOut - INTEGER(IntKi) :: K_local + INTEGER(IntKi) :: J_local, K_local INTEGER(B4Ki), PARAMETER :: File_ID = 3 INTEGER(B4Ki) :: NumBl @@ -9206,16 +6514,18 @@ SUBROUTINE WriteInputMeshesToFile(u_ED, u_AD, u_SD, u_HD, u_MAP, u_BD, FileName, ! Add a file identification number (in case we ever have to change this): WRITE( unOut, IOSTAT=ErrStat ) File_ID + do J_local = 1,size(u_ED) ! Add how many blade meshes there are: - NumBl = SIZE(u_ED%BladePtLoads,1) ! Note that NumBl is B4Ki - WRITE( unOut, IOSTAT=ErrStat ) NumBl + NumBl = SIZE(u_ED(J_local)%BladePtLoads,1) ! Note that NumBl is B4Ki + WRITE( unOut, IOSTAT=ErrStat ) NumBl ! Add all of the input meshes: - DO K_local = 1,NumBl - CALL MeshWrBin( unOut, u_ED%BladePtLoads(K_local), ErrStat, ErrMsg ) - END DO - CALL MeshWrBin( unOut, u_ED%TowerPtLoads, ErrStat, ErrMsg ) - CALL MeshWrBin( unOut, u_ED%PlatformPtMesh, ErrStat, ErrMsg ) + DO K_local = 1,NumBl + CALL MeshWrBin( unOut, u_ED(J_local)%BladePtLoads(K_local), ErrStat, ErrMsg ) + END DO + CALL MeshWrBin( unOut, u_ED(J_local)%TowerPtLoads, ErrStat, ErrMsg ) + CALL MeshWrBin( unOut, u_ED(J_local)%PlatformPtMesh, ErrStat, ErrMsg ) + end do CALL MeshWrBin( unOut, u_SD%TPMesh, ErrStat, ErrMsg ) CALL MeshWrBin( unOut, u_SD%LMesh, ErrStat, ErrMsg ) CALL MeshWrBin( unOut, u_HD%Morison%Mesh, ErrStat, ErrMsg ) @@ -9248,7 +6558,7 @@ END SUBROUTINE WriteInputMeshesToFile !! will be opened for writing (FileName). It is up to the caller of this routine to close the file. SUBROUTINE WriteMotionMeshesToFile(time, y_ED, u_SD, y_SD, u_HD, u_MAP, y_BD, u_BD, UnOut, ErrStat, ErrMsg, FileName) REAL(DbKi), INTENT(IN) :: time !< current simulation time - TYPE(ED_OutputType), INTENT(IN) :: y_ED !< ElastoDyn outputs + TYPE(ED_OutputType), INTENT(IN) :: y_ED(:) !< ElastoDyn outputs TYPE(SD_InputType), INTENT(IN) :: u_SD !< SubDyn inputs TYPE(SD_OutputType), INTENT(IN) :: y_SD !< SubDyn outputs TYPE(HydroDyn_InputType), INTENT(IN) :: u_HD !< HydroDyn inputs @@ -9264,7 +6574,7 @@ SUBROUTINE WriteMotionMeshesToFile(time, y_ED, u_SD, y_SD, u_HD, u_MAP, y_BD, u_ REAL(R8Ki) :: t - INTEGER(IntKi) :: K_local + INTEGER(IntKi) :: J_local, K_local INTEGER(B4Ki), PARAMETER :: File_ID = 101 INTEGER(B4Ki) :: NumBl @@ -9287,8 +6597,10 @@ SUBROUTINE WriteMotionMeshesToFile(time, y_ED, u_SD, y_SD, u_HD, u_MAP, y_BD, u_ WRITE( unOut, IOSTAT=ErrStat ) File_ID ! Add how many blade meshes there are: - NumBl = SIZE(y_ED%BladeLn2Mesh,1) ! Note that NumBl is B4Ki - WRITE( unOut, IOSTAT=ErrStat ) NumBl + do J_local = 1,size(y_ED) + NumBl = SIZE(y_ED(J_local)%BladeLn2Mesh,1) ! Note that NumBl is B4Ki + WRITE( unOut, IOSTAT=ErrStat ) NumBl + end do !FIXME: if y_BD is not allocated, size could return garbage here!!!! NumBl = SIZE(y_BD,1) ! Note that NumBl is B4Ki WRITE( unOut, IOSTAT=ErrStat ) NumBl @@ -9297,11 +6609,13 @@ SUBROUTINE WriteMotionMeshesToFile(time, y_ED, u_SD, y_SD, u_HD, u_MAP, y_BD, u_ WRITE( unOut, IOSTAT=ErrStat ) t ! Add all of the meshes with motions: - DO K_local = 1,SIZE(y_ED%BladeLn2Mesh,1) - CALL MeshWrBin( unOut, y_ED%BladeLn2Mesh(K_local), ErrStat, ErrMsg ) - END DO - CALL MeshWrBin( unOut, y_ED%TowerLn2Mesh, ErrStat, ErrMsg ) - CALL MeshWrBin( unOut, y_ED%PlatformPtMesh, ErrStat, ErrMsg ) + do J_local = 1,size(y_ED) + DO K_local = 1,SIZE(y_ED(J_local)%BladeLn2Mesh,1) + CALL MeshWrBin( unOut, y_ED(J_local)%BladeLn2Mesh(K_local), ErrStat, ErrMsg ) + END DO + CALL MeshWrBin( unOut, y_ED(J_local)%TowerLn2Mesh, ErrStat, ErrMsg ) + CALL MeshWrBin( unOut, y_ED(J_local)%PlatformPtMesh, ErrStat, ErrMsg ) + end do CALL MeshWrBin( unOut, u_SD%TPMesh, ErrStat, ErrMsg ) CALL MeshWrBin( unOut, y_SD%y2Mesh, ErrStat, ErrMsg ) CALL MeshWrBin( unOut, y_SD%y3Mesh, ErrStat, ErrMsg ) @@ -9365,38 +6679,47 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) 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 = 'FAST_Linearize_T' + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message 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(*), PARAMETER :: RoutineName = 'FAST_Linearize_T' + INTEGER(IntKi) :: i ! loop counter ErrStat = ErrID_None ErrMsg = "" - if ( .not. Turbine%p_FAST%Linearize ) return + ! Skip function if not performing linearization + if (.not. Turbine%p_FAST%Linearize) return + + ! Calculate current time + t_global = t_initial + n_t_global*Turbine%p_FAST%dt + ! If linearization times specified directly (not using CalcSteady) 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??? + if (Turbine%m_Glue%Lin%TimeIndex <= Turbine%p_FAST%NLinTimes) then !bjj: maybe this logic should go in FAST_Linearize_OP??? - next_lin_time = Turbine%m_FAST%Lin%LinTimes( Turbine%m_FAST%Lin%NextLinTimeIndx ) - t_global = t_initial + n_t_global*Turbine%p_FAST%dt + ! Get next linearization time + next_lin_time = Turbine%m_FAST%Lin%LinTimes(Turbine%m_Glue%Lin%TimeIndex) - if ( EqualRealNos( t_global, next_lin_time ) .or. t_global > next_lin_time ) then + ! If current time is greater than or very close to next linearization time + if ((t_global > next_lin_time) .or. EqualRealNos(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%ExtInfw, & - Turbine%HD, Turbine%SeaSt, 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 + ! Perform linearization + call ModGlue_Linearize_OP(Turbine%p_Glue, Turbine%m_Glue, Turbine%y_Glue, & + Turbine%p_FAST, Turbine%m_FAST, Turbine%y_FAST, t_global, Turbine, 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() + ! If VTK flag is for modeshapes and all of the times have been linearizaed + if ((Turbine%p_FAST%WrVTK == VTK_ModeShapes) .and. & + (Turbine%m_Glue%Lin%TimeIndex > Turbine%p_FAST%NLinTimes)) then + ! 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 if end if @@ -9405,65 +6728,74 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) else ! CalcSteady - t_global = t_initial + n_t_global*Turbine%p_FAST%dt + 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%ExtInfw, Turbine%HD, Turbine%SeaSt, 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 ) + ! Perform steady state calculation + call ModGlue_CalcSteady(n_t_global, t_global, Turbine%p_Glue, Turbine%m_Glue, Turbine%y_Glue, & + Turbine%p_FAST, Turbine%m_FAST, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (Turbine%m_FAST%Lin%FoundSteady) then - if (Turbine%m_FAST%Lin%ForceLin) then - Turbine%p_FAST%NLinTimes=1 - endif + ! Save this for use elsewhere in the code + Turbine%m_FAST%Lin%FoundSteady = Turbine%m_Glue%CS%FoundSteady - do iLinTime=1,Turbine%p_FAST%NLinTimes - t_global = Turbine%m_FAST%Lin%LinTimes(iLinTime) + ! If steady state was found + if (Turbine%m_Glue%CS%FoundSteady) then - call SetOperatingPoint(iLinTime, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, Turbine%ED, Turbine%BD, Turbine%SrvD, & - Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%HD, Turbine%SeaSt, 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 linearization was forced, only linearize at first time + if (Turbine%m_Glue%CS%ForceLin) then + Turbine%p_FAST%NLinTimes = 1 + endif - if (Turbine%p_FAST%DT_UJac < Turbine%p_FAST%TMax) then - Turbine%m_FAST%calcJacobian = .true. - Turbine%m_FAST%NextJacCalcTime = t_global - end if + ! Loop through linearization times + do iLinTime = 1, Turbine%p_FAST%NLinTimes - 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%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, & - 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 + ! Set global time to saved linearization time + t_global = Turbine%y_Glue%Lin%Times(iLinTime) - 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%ExtInfw, & - Turbine%HD, Turbine%SeaSt, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) + ! Restore operating point so linearization can be performed + call ModGlue_RestoreOperatingPoint(Turbine%p_Glue, Turbine%m_Glue, iLinTime, Turbine, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN + ! Calculate outputs using restored operating points + do i = 1, size(Turbine%m_Glue%ModData) + call FAST_CalcOutput(Turbine%m_Glue%ModData(i), Turbine%m_Glue%Mappings, & + t_global, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + ! call CalcOutputs_And_SolveForInputs(Turbine%p_Glue%TC, Turbine%m_Glue%TC, & + ! Turbine%m_Glue%ModData, Turbine%m_Glue%Mappings, & + ! t_global, INPUT_CURR, STATE_CURR, Turbine, ErrStat2, ErrMsg2) + ! call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! if (ErrStat >= AbortErrLev) return + + ! Linearize at operating points + call ModGlue_Linearize_OP(Turbine%p_Glue, Turbine%m_Glue, Turbine%y_Glue, & + Turbine%p_FAST, Turbine%m_FAST, Turbine%y_FAST, t_global, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do - if (Turbine%p_FAST%WrVTK == VTK_ModeShapes) CALL WrVTKCheckpoint() + ! If mode shape VTKs were requested, write checkpoint file + if (Turbine%p_FAST%WrVTK == VTK_ModeShapes) then + ! 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 if - if (Turbine%m_FAST%Lin%ForceLin) then + ! If linearization was forced, display message + if (Turbine%m_Glue%CS%ForceLin) then ErrStat2 = ErrID_Warn ErrMsg2 = 'Linearization was forced at simulation end. The linearized model may not be sufficiently representative of the solution in steady state.' - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) endif 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 !---------------------------------------------------------------------------------------------------------------------------------- @@ -9481,36 +6813,129 @@ SUBROUTINE ExitThisProgram_T( Turbine, ErrLevel_in, StopTheProgram, ErrLocMsg, S 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 + CHARACTER(*), PARAMETER :: RoutineName = 'ExitThisProgram' INTEGER(IntKi) :: ErrStat CHARACTER(ErrMsgLen) :: ErrMsg + INTEGER(IntKi) :: UnSum + INTEGER(IntKi) :: ErrorLevel + LOGICAL :: PrintRunTimes + CHARACTER(1224) :: SimMsg ! optional message to print about where the error took place in the simulation + INTEGER(IntKi) :: StrtTime(8) + REAL(ReKi) :: UsrTime1 + INTEGER(IntKi) :: SimStrtTime(8) + REAL(ReKi) :: UsrTime2 + REAL(DbKi) :: t_global + CHARACTER(4) :: TDesc + + ! Store incomming error level + ErrorLevel = ErrLevel_in - IF (PRESENT(SkipRunTimeMsg)) THEN - SkipRunTimes = SkipRunTimeMsg - ELSE - SkipRunTimes = .FALSE. + ! Set flag to print runtimes depending on argument + if (present(SkipRunTimeMsg)) then + PrintRunTimes = .not. SkipRunTimeMsg + else + PrintRunTimes = .true. + end if + + ! Print runtime if write status flag is set + PrintRunTimes = PrintRunTimes .and. Turbine%p_FAST%WrSttsTime + + ! Save some data before destorying TurbineType + unSum = Turbine%y_FAST%UnSum + StrtTime = Turbine%m_FAST%StrtTime + UsrTime1 = Turbine%m_FAST%UsrTime1 + SimStrtTime = Turbine%m_FAST%SimStrtTime + UsrTime2 = Turbine%m_FAST%UsrTime2 + t_global = Turbine%m_FAST%t_global + TDesc = Turbine%p_FAST%TDesc + + ! for debugging, let's output the meshes and all of their fields + IF ((ErrorLevel >= AbortErrLev) .and. & + (Turbine%p_FAST%WrVTK > VTK_None) .and. & + (.not. Turbine%m_FAST%Lin%FoundSteady)) THEN + Turbine%p_FAST%VTK_OutFileRoot = trim(Turbine%p_FAST%VTK_OutFileRoot)//'.DebugError' + Turbine%p_FAST%VTK_fields = .true. + CALL WrVTK_AllMeshes(Turbine%p_FAST, Turbine%y_FAST, Turbine%MeshMapData, Turbine%ED, & + Turbine%SED, Turbine%BD, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%SrvD, Turbine%MAP, & + Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD) + end if + + ! If we are doing AeroMaps, there is leftover data in AD15 parameters + if (Turbine%p_FAST%CompAeroMaps) then + if (associated(Turbine%AD%p%FlowField)) deallocate(Turbine%AD%p%FlowField) + endif + + ! End all modules + if (allocated(Turbine%m_Glue%ModData)) then + CALL FAST_ModEnd(Turbine%m_Glue%ModData, Turbine, ErrStat, ErrMsg) + IF (ErrStat /= ErrID_None) THEN + CALL WrScr(NewLine//RoutineName//':'//TRIM(ErrMsg)//NewLine) + ErrorLevel = MAX(ErrorLevel,ErrStat) + END IF + end if + + ! Write output to file (do this after ending modules so that we have more memory to use if needed) + call FAST_EndOutput(Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, ErrStat, ErrMsg) + IF (ErrStat /= ErrID_None) THEN + CALL WrScr(NewLine//RoutineName//':'//TRIM(ErrMsg)//NewLine) + ErrorLevel = MAX(ErrorLevel,ErrStat) + END IF + + ! Destroy all data associated with FAST variables: + call FAST_DestroyTurbineType(Turbine, ErrStat, ErrMsg) + IF (ErrStat /= ErrID_None) THEN + CALL WrScr(NewLine//RoutineName//':'//TRIM(ErrMsg)//NewLine) + ErrorLevel = MAX(ErrorLevel,ErrStat) END IF + !---------------------------------------------------------------------------- + ! Set exit error code if there was an error + !---------------------------------------------------------------------------- - IF (PRESENT(ErrLocMsg)) THEN + IF (ErrorLevel >= AbortErrLev) THEN - CALL ExitThisProgram( Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%IfW, Turbine%ExtInfw, & - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram, ErrLocMsg, SkipRunTimes ) + IF (PRESENT(ErrLocMsg)) THEN + SimMsg = ErrLocMsg + ELSE + SimMsg = 'after the simulation completed' + END IF - ELSE + IF (UnSum > 0) THEN + CLOSE(UnSum) + UnSum = -1 + END IF - CALL ExitThisProgram( Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%IfW, Turbine%ExtInfw, & - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram, SkipRunTimeMsg=SkipRunTimes ) + SimMsg = trim(FAST_Ver%Name)//' encountered an error '//trim(SimMsg)//'.'//NewLine//' Simulation error level: '//GetErrStr(ErrorLevel) + if (StopTheProgram) then + CALL ProgAbort(SimMsg, TrapErrors=.FALSE., TimeWait=3._ReKi) ! wait 3 seconds (in case they double-clicked and got an error) + else + CALL WrScr(trim(SimMsg)) + end if END IF + !---------------------------------------------------------------------------- + ! Write simulation times and stop + !---------------------------------------------------------------------------- + + ! Print runtime if write status time + IF (PrintRunTimes) THEN + CALL RunTimes(StrtTime, UsrTime1, SimStrtTime, UsrTime2, t_global, & + UnSum=UnSum, DescStrIn=TDesc) + END IF - CALL FAST_DestroyTurbineType( Turbine, ErrStat, ErrMsg) ! just in case we missed some data in ExitThisProgram() + ! Close summary file if opened + IF (UnSum > 0) CLOSE(UnSum) + if (StopTheProgram) then +#if (defined COMPILE_SIMULINK || defined COMPILE_LABVIEW) + ! for Simulink, this may not be a normal stop. It might call this after an error in the model. + CALL WrScr(NewLine//' '//TRIM(FAST_Ver%Name)//' completed.'//NewLine) +#else + CALL NormStop() +#endif + end if END SUBROUTINE ExitThisProgram_T !---------------------------------------------------------------------------------------------------------------------------------- @@ -9555,6 +6980,7 @@ SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ! Local variables: + TYPE(FAST_TurbineType) :: T INTEGER(IntKi) :: ErrorLevel LOGICAL :: PrintRunTimes @@ -9565,89 +6991,7 @@ SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, CHARACTER(*), PARAMETER :: RoutineName = 'ExitThisProgram' - ErrorLevel = ErrLevel_in - - ! for debugging, let's output the meshes and all of their fields - IF ( ErrorLevel >= AbortErrLev .AND. p_FAST%WrVTK > VTK_None .and. .not. m_FAST%Lin%FoundSteady) THEN - p_FAST%VTK_OutFileRoot = trim(p_FAST%VTK_OutFileRoot)//'.DebugError' - p_FAST%VTK_fields = .true. - CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - end if - - - ! If we are doing AeroMaps, there is leftover data in AD15 parameters - if (p_FAST%CompAeroMaps) then - if (associated(AD%p%FlowField)) deallocate(AD%p%FlowField) - endif - - - ! End all modules - CALL FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, IfW, SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) - IF (ErrStat2 /= ErrID_None) THEN - CALL WrScr( NewLine//RoutineName//':'//TRIM(ErrMsg2)//NewLine ) - ErrorLevel = MAX(ErrorLevel,ErrStat2) - END IF - - ! Destroy all data associated with FAST variables: - - CALL FAST_DestroyAll( p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) - IF (ErrStat2 /= ErrID_None) THEN - CALL WrScr( NewLine//RoutineName//':'//TRIM(ErrMsg2)//NewLine ) - ErrorLevel = MAX(ErrorLevel,ErrStat2) - END IF - - - !............................................................................................................................ - ! Set exit error code if there was an error; - !............................................................................................................................ - IF ( ErrorLevel >= AbortErrLev ) THEN - - IF (PRESENT(ErrLocMsg)) THEN - SimMsg = ErrLocMsg - 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 = TRIM(FAST_Ver%Name)//' encountered an error '//TRIM(SimMsg)//'.'//NewLine//' Simulation error level: '//TRIM(GetErrStr(ErrorLevel)) - if (StopTheProgram) then - CALL ProgAbort( trim(SimMsg), TrapErrors=.FALSE., TimeWait=3._ReKi ) ! wait 3 seconds (in case they double-clicked and got an error) - else - CALL WrScr(trim(SimMsg)) - end if - - END IF - - !............................................................................................................................ - ! Write simulation times and stop - !............................................................................................................................ - 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) - ! for Simulink, this may not be a normal stop. It might call this after an error in the model. - CALL WrScr( NewLine//' '//TRIM(FAST_Ver%Name)//' completed.'//NewLine ) -#else - CALL NormStop( ) -#endif - end if + END SUBROUTINE ExitThisProgram @@ -9718,293 +7062,6 @@ SUBROUTINE FAST_EndOutput( p_FAST, y_FAST, m_FAST, ErrStat, ErrMsg ) END SUBROUTINE FAST_EndOutput -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine calls the end routines for each module that was previously initialized. -SUBROUTINE FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, IfW, SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, 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(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-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(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk 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(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState 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) :: i, k ! loop counter - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_EndMods' - - !............................................................................................................................... - ! End all modules (and write binary FAST output file) - !............................................................................................................................... - - ErrStat = ErrID_None - ErrMsg = "" - - - 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%y, ED%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END IF - - IF ( p_FAST%ModuleInitialized(Module_SED) ) THEN - CALL SED_End( SED%Input(1), SED%p, SED%x(STATE_CURR), SED%xd(STATE_CURR), SED%z(STATE_CURR), SED%OtherSt(STATE_CURR), & - SED%y, SED%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END IF - - IF ( p_FAST%ModuleInitialized(Module_BD) ) THEN - - DO k=1,p_FAST%nBeams - CALL BD_End(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), ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END DO - - END IF - - - IF ( p_FAST%ModuleInitialized(Module_AD) ) THEN - CALL AD_End( 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ELSEIF ( p_FAST%ModuleInitialized(Module_ADsk) ) THEN - CALL ADsk_End( ADsk%Input(1), ADsk%p, ADsk%x(STATE_CURR), ADsk%xd(STATE_CURR), ADsk%z(STATE_CURR), & - ADsk%OtherSt(STATE_CURR), ADsk%y, ADsk%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END IF - - IF ( p_FAST%ModuleInitialized(Module_IfW) ) THEN - CALL InflowWind_End( 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, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END IF - - IF ( p_FAST%ModuleInitialized(Module_SrvD) ) THEN - CALL SrvD_End( 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, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END IF - - IF ( p_FAST%ModuleInitialized(Module_HD) ) THEN - CALL HydroDyn_End( 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, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END IF - - IF ( p_FAST%ModuleInitialized(Module_SD) ) THEN - CALL SD_End( 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, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ELSE IF ( p_FAST%ModuleInitialized(Module_ExtPtfm) ) THEN - CALL ExtPtfm_End( 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) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END IF - - IF ( p_FAST%ModuleInitialized(Module_MAP) ) THEN - CALL MAP_End( MAPp%Input(1), MAPp%p, MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), MAPp%OtherSt, & - MAPp%y, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ELSEIF ( p_FAST%ModuleInitialized(Module_MD) ) THEN - CALL MD_End( 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, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ELSEIF ( p_FAST%ModuleInitialized(Module_FEAM) ) THEN - CALL FEAM_End( 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, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ELSEIF ( p_FAST%ModuleInitialized(Module_Orca) ) THEN - CALL Orca_End( 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, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END IF - - IF ( p_FAST%ModuleInitialized(Module_IceF) ) THEN - CALL IceFloe_End(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, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ELSEIF ( p_FAST%ModuleInitialized(Module_IceD) ) THEN - - DO i=1,p_FAST%numIceLegs - CALL IceD_End(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), ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END DO - - END IF - - IF ( p_FAST%ModuleInitialized(Module_SeaSt) ) THEN - ! make sure this is done AFTER any module that may be pointing to SeaSt data -- we deallocate the pointer targets here - CALL SeaSt_End( SeaSt%Input(1), SeaSt%p, SeaSt%x(STATE_CURR), SeaSt%xd(STATE_CURR), SeaSt%z(STATE_CURR), SeaSt%OtherSt(STATE_CURR), & - SeaSt%y, SeaSt%m, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END IF - - - - ! Write output to file (do this after ending modules so that we have more memory to use if needed) - CALL FAST_EndOutput( p_FAST, y_FAST, m_FAST, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - -END SUBROUTINE FAST_EndMods -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine calls the destroy routines for each module. (It is basically a duplicate of FAST_DestroyTurbineType().) -SUBROUTINE FAST_DestroyAll( p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, 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(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-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(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data - TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState 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 - - 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 - - ! local variables - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyAll' - - - - ! ------------------------------------------------------------------------- - ! Deallocate/Destroy structures associated with mesh mapping - ! ------------------------------------------------------------------------- - - ErrStat = ErrID_None - ErrMsg = "" - - - ! FAST - CALL FAST_DestroyParam( p_FAST, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL FAST_DestroyOutputFileType( y_FAST, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL FAST_DestroyMisc( m_FAST, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ElastoDyn - CALL FAST_DestroyElastoDyn_Data( ED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! Simplified-ElastoDyn - CALL FAST_DestroySED_Data( SED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! BeamDyn - CALL FAST_DestroyBeamDyn_Data( BD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ServoDyn - CALL FAST_DestroyServoDyn_Data( SrvD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! AeroDyn - CALL FAST_DestroyAeroDyn_Data( AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! InflowWind - CALL FAST_DestroyInflowWind_Data( IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ExternalInflow - CALL FAST_DestroyExternalInflow_Data( ExtInfw, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! SeaState - CALL FAST_DestroySeaState_Data( SeaSt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! HydroDyn - CALL FAST_DestroyHydroDyn_Data( HD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! SubDyn - CALL FAST_DestroySubDyn_Data( SD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ExtPtfm - CALL FAST_DestroyExtPtfm_Data( ExtPtfm, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! MAP - CALL FAST_DestroyMAP_Data( MAPp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! FEAMooring - CALL FAST_DestroyFEAMooring_Data( FEAM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! MoorDyn - CALL FAST_DestroyMoorDyn_Data( MD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! Orca - CALL FAST_DestroyOrcaFlex_Data( Orca, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! IceFloe - CALL FAST_DestroyIceFloe_Data( IceF, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! IceDyn - CALL FAST_DestroyIceDyn_Data( IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! Module (Mesh) Mapping data - CALL FAST_DestroyModuleMapType( MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - - END SUBROUTINE FAST_DestroyAll -!---------------------------------------------------------------------------------------------------------------------------------- - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! CHECKPOINT/RESTART ROUTINES @@ -10381,7 +7438,7 @@ SUBROUTINE FAST_RestoreForVTKModeShape_Tary(t_initial, Turbine, InputFileName, E Turbine(i_turb)%ED, Turbine(i_turb)%SED, Turbine(i_turb)%BD, Turbine(i_turb)%SrvD, & Turbine(i_turb)%AD, Turbine(i_turb)%ADsk, Turbine(i_turb)%ExtLd, Turbine(i_turb)%IfW, Turbine(i_turb)%ExtInfw, & Turbine(i_turb)%SeaSt, 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 ) + Turbine(i_turb)%IceF, Turbine(i_turb)%IceD, Turbine(i_turb)%MeshMapData, trim(InputFileName), Turbine(i_turb), ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -10391,7 +7448,7 @@ 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, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, InputFileName, ErrStat, ErrMsg ) + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, InputFileName, Turbine, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial time @@ -10421,6 +7478,7 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules CHARACTER(*), INTENT(IN ) :: InputFileName !< Name of the input file + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< Turbine type INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -10499,20 +7557,22 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, m_FAST%NextJacCalcTime = m_FAST%Lin%LinTimes(iLinTime) end if - call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Restore operating point + call ModGlue_RestoreOperatingPoint(Turbine%p_Glue, Turbine%m_Glue, iLinTime, Turbine, 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, ExtInfw, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & - IceF, IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN + ! TODO: Fix perturbing OPs and calculating inputs/outputs - CALL CalcOutputs_And_SolveForInputs( -1, m_FAST%Lin%LinTimes(iLinTime), STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & - p_FAST, m_FAST, .true., ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN + ! ! 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, ExtInfw, 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, AD, ExtLd, IfW, ExtInfw, 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, SED, BD, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) @@ -10531,20 +7591,22 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, do it = 1,nt tprime = (it-1)*dt - call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Restore operating point + call ModGlue_RestoreOperatingPoint(Turbine%p_Glue, Turbine%m_Glue, iLinTime, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! TODO: Fix perturbing OPs and calculating inputs/outputs - ! 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, ExtInfw, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & - IceF, IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN + ! ! 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, ExtInfw, 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, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, 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, AD, ExtLd, IfW, ExtInfw, 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, SED, BD, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) @@ -10866,6 +7928,54 @@ SUBROUTINE Cleanup() END SUBROUTINE Cleanup END SUBROUTINE ReadModeShapeFile + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine sets the inputs required for ServoDyn from an external source (Simulink) +SUBROUTINE SrvD_SetExternalInputs(p_FAST, m_FAST, u_SrvD) + + TYPE(FAST_ParameterType), INTENT(IN) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_MiscVarType), INTENT(IN) :: m_FAST !< Glue-code misc variables (including inputs from external sources like Simulink) + TYPE(SrvD_InputType), INTENT(INOUT) :: u_SrvD !< ServoDyn Inputs at t + + INTEGER(IntKi) :: i ! loop counter + + ! we are going to use extrapolated values because these external values from Simulink are at n instead of n+1 + u_SrvD%ExternalGenTrq = m_FAST%ExternInput%GenTrq + u_SrvD%ExternalElecPwr = m_FAST%ExternInput%ElecPwr + u_SrvD%ExternalYawPosCom = m_FAST%ExternInput%YawPosCom + u_SrvD%ExternalYawRateCom = m_FAST%ExternInput%YawRateCom + u_SrvD%ExternalHSSBrFrac = m_FAST%ExternInput%HSSBrFrac + + if (ALLOCATED(u_SrvD%ExternalBlPitchCom)) then !there should be no reason this isn't allocated, but ExternalInflow is acting strange... + do i=1,SIZE(u_SrvD%ExternalBlPitchCom) + u_SrvD%ExternalBlPitchCom(i) = m_FAST%ExternInput%BlPitchCom(i) + end do + end if + + if (ALLOCATED(u_SrvD%ExternalBlAirfoilCom)) then ! Added Blade Flap use with Simulink + do i=1,SIZE(u_SrvD%ExternalBlAirfoilCom) + u_SrvD%ExternalBlAirfoilCom(i) = m_FAST%ExternInput%BlAirfoilCom(i) + end do + end if + + ! Cable controls + if (ALLOCATED(u_SrvD%ExternalCableDeltaL)) then ! This is only allocated if cable control signals are requested + do i=1,min(SIZE(u_SrvD%ExternalCableDeltaL),SIZE(m_FAST%ExternInput%CableDeltaL)) + u_SrvD%ExternalCableDeltaL(i) = m_FAST%ExternInput%CableDeltaL(i) + end do + end if + + if (ALLOCATED(u_SrvD%ExternalCableDeltaLdot)) then ! This is only allocated if cable control signals are requested + do i=1,min(SIZE(u_SrvD%ExternalCableDeltaLdot),SIZE(m_FAST%ExternInput%CableDeltaLdot)) + u_SrvD%ExternalCableDeltaLdot(i) = m_FAST%ExternInput%CableDeltaLdot(i) + end do + end if + + ! StC controls + ! This is a placeholder for where StC controls would be passed if they are enabled from Simulink + +END SUBROUTINE SrvD_SetExternalInputs + !---------------------------------------------------------------------------------------------------------------------------------- END MODULE FAST_Subs !---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 125d2a0643..487d412ccd 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -31,6 +31,7 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE FAST_Types !--------------------------------------------------------------------------------------------------------------------------------- +USE Glue_Types USE ElastoDyn_Types USE SED_Types USE BeamDyn_Types @@ -52,38 +53,38 @@ MODULE FAST_Types USE ExtPtfm_MCKF_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Unknown = -1 ! Unknown [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_None = 0 ! No module selected [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Glue = 1 ! Glue code [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IfW = 2 ! InflowWind [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtInfw = 3 ! ExternalInflow [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ED = 4 ! ElastoDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_BD = 5 ! BeamDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_AD = 7 ! AeroDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtLd = 8 ! ExternalLoads [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SrvD = 9 ! ServoDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SeaSt = 10 ! SeaState [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_HD = 11 ! HydroDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SD = 12 ! SubDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtPtfm = 13 ! External Platform Loading MCKF [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MAP = 14 ! MAP (Mooring Analysis Program) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_FEAM = 15 ! FEAMooring [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MD = 16 ! MoorDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Orca = 17 ! OrcaFlex integration (HD/Mooring) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceF = 18 ! IceFloe [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceD = 19 ! IceDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ADsk = 20 ! AeroDisk [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SED = 21 ! Simplified-ElastoDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: NumModules = 21 ! The number of modules available in FAST [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: MaxNBlades = 3 ! Maximum number of blades allowed on a turbine [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: IceD_MaxLegs = 4 ! because I don't know how many legs there are before calling IceD_Init and I don't want to copy the data because of sibling mesh issues, I'm going to allocate IceD based on this number [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Pitch = 1 ! pitch [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_TSR = 2 ! TSR [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_WS = 3 ! wind speed [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_RotSpeed = 4 ! rotor speed [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Err = 5 ! err in the ss solve [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Iter = 6 ! number of iterations [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: NumStateTimes = 4 ! size of arrays of state derived types (Continuous state type etc). (STATE_CURR, STATE_PRED, STATE_SAVED_CURR, STATE_SAVED_PRED) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Unknown = -1 ! Unknown [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_None = 0 ! No module selected [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Glue = 1 ! Glue code [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IfW = 2 ! InflowWind [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtInfw = 3 ! ExternalInflow [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ED = 4 ! ElastoDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_BD = 5 ! BeamDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_AD = 7 ! AeroDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtLd = 8 ! ExternalLoads [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SrvD = 9 ! ServoDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SeaSt = 10 ! SeaState [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_HD = 11 ! HydroDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SD = 12 ! SubDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtPtfm = 13 ! External Platform Loading MCKF [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MAP = 14 ! MAP (Mooring Analysis Program) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_FEAM = 15 ! FEAMooring [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MD = 16 ! MoorDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Orca = 17 ! OrcaFlex integration (HD/Mooring) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceF = 18 ! IceFloe [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceD = 19 ! IceDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ADsk = 20 ! AeroDisk [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SED = 21 ! Simplified-ElastoDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: NumModules = 21 ! The number of modules available in FAST [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MaxNBlades = 3 ! Maximum number of blades allowed on a turbine [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: IceD_MaxLegs = 4 ! because I don't know how many legs there are before calling IceD_Init and I don't want to copy the data because of sibling mesh issues, I'm going to allocate IceD based on this number [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Pitch = 1 ! pitch [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_TSR = 2 ! TSR [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_WS = 3 ! wind speed [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_RotSpeed = 4 ! rotor speed [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Err = 5 ! err in the ss solve [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Iter = 6 ! number of iterations [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: NumStateTimes = 4 ! size of arrays of state derived types (Continuous state type etc). (STATE_CURR, STATE_PRED, STATE_SAVED_CURR, STATE_SAVED_PRED) [-] ! ========= FAST_VTK_BLSurfaceType ======= TYPE, PUBLIC :: FAST_VTK_BLSurfaceType REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: AirfoilCoords !< x,y coordinates for airfoil around each blade node on a blade (relative to reference) [-] @@ -143,6 +144,9 @@ MODULE FAST_Types INTEGER(IntKi) :: nBeams = 0_IntKi !< number of BeamDyn instances [-] LOGICAL :: BD_OutputSibling = .false. !< flag to determine if BD input is sibling of output mesh [-] LOGICAL , DIMENSION(1:NumModules) :: ModuleInitialized = .false. !< An array determining if the module has been initialized [-] + REAL(DbKi) :: RhoInf = 0.0_R8Ki !< Numerical damping parameter for tight coupling generalized-alpha integrator (-) [0.0 to 1.0] [-] + REAL(DbKi) :: ConvTol = 0.0_R8Ki !< Convergence iteration error tolerance for tight coupling generalized alpha integrator (-) [-] + INTEGER(IntKi) :: MaxConvIter = 0_IntKi !< Maximum number of convergence iterations for tight coupling generalized alpha integrator (-) [-] REAL(DbKi) :: DT_Ujac = 0.0_R8Ki !< Time between when we need to re-calculate these Jacobians [s] REAL(ReKi) :: UJacSclFact = 0.0_ReKi !< Scaling factor used to get similar magnitudes between accelerations, forces, and moments in Jacobians [-] INTEGER(IntKi) , DIMENSION(1:9) :: SizeJac_Opt1 = 0_IntKi !< (1)=size of matrix; (2)=size of ED portion; (3)=size of SD portion [2 meshes]; (4)=size of HD portion; (5)=size of BD portion blade 1; (6)=size of BD portion blade 2; (7)=size of BD portion blade 3; (8)=size of Orca portion; (9)=size of ExtPtfm portion; [-] @@ -237,79 +241,6 @@ MODULE FAST_Types INTEGER(IntKi) :: GearBox_index = 0_IntKi !< Index to gearbox rotation in state array (for steady-state calculations) [-] 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(SeaSt_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_SeaSt !< Continuous states [-] - TYPE(SeaSt_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_SeaSt !< Discrete states [-] - TYPE(SeaSt_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_SeaSt !< Constraint states [-] - TYPE(SeaSt_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_SeaSt !< Other states [-] - TYPE(SeaSt_InputType) , DIMENSION(:), ALLOCATABLE :: u_SeaSt !< 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 [-] @@ -332,8 +263,6 @@ MODULE FAST_Types REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: C !< C matrix [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: D !< D matrix [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: StateRotation !< Matrix that rotates the continuous states [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: StateRel_x !< Matrix that defines the continuous states relative to root motion [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: StateRel_xdot !< Matrix that defines the continuous states relative to root motion [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Whether the input is a load (used for scaling for potentially ill-conditioned G matrix) [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Whether corresponding input is in rotating frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_y !< Whether corresponding output is in rotating frame [-] @@ -396,7 +325,6 @@ MODULE FAST_Types INTEGER(IntKi) :: VTK_LastWaveIndx = 0_IntKi !< last index into wave array [-] TYPE(FAST_LinFileType) :: Lin !< linearization data for output [-] INTEGER(IntKi) :: ActualChanLen = 0_IntKi !< width of the column headers output in the text and/or binary file [-] - TYPE(FAST_LinStateSave) :: op !< operating points of states and inputs for VTK output of mode shapes [-] REAL(ReKi) , DIMENSION(1:6) :: DriverWriteOutput = 0.0_ReKi !< pitch and tsr for current aero map case, plus error, number of iterations, wind speed, rotor speed [-] END TYPE FAST_OutputFileType ! ======================= @@ -407,13 +335,10 @@ MODULE FAST_Types TYPE(IceD_ConstraintStateType) , DIMENSION(:,:), ALLOCATABLE :: z !< Constraint states [-] TYPE(IceD_OtherStateType) , DIMENSION(:,:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(IceD_ParameterType) , DIMENSION(:), ALLOCATABLE :: p !< Parameters [-] - TYPE(IceD_InputType) , DIMENSION(:), ALLOCATABLE :: u !< System inputs [-] TYPE(IceD_OutputType) , DIMENSION(:), ALLOCATABLE :: y !< System outputs [-] TYPE(IceD_MiscVarType) , DIMENSION(:), ALLOCATABLE :: m !< Misc/optimization variables [-] TYPE(IceD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(IceD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE IceDyn_Data ! ======================= ! ========= BeamDyn_Data ======= @@ -423,87 +348,62 @@ MODULE FAST_Types TYPE(BD_ConstraintStateType) , DIMENSION(:,:), ALLOCATABLE :: z !< Constraint states [-] TYPE(BD_OtherStateType) , DIMENSION(:,:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(BD_ParameterType) , DIMENSION(:), ALLOCATABLE :: p !< Parameters [-] - 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 [-] - TYPE(BD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE BeamDyn_Data ! ======================= ! ========= ElastoDyn_Data ======= TYPE, PUBLIC :: ElastoDyn_Data - TYPE(ED_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(ED_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(ED_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(ED_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] - TYPE(ED_ParameterType) :: p !< Parameters [-] - 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 CalcSteady Azimuths [-] - TYPE(ED_OutputType) , DIMENSION(:), ALLOCATABLE :: Output_bak !< Backup Array of outputs associated with InputTimes [-] - TYPE(ED_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] - TYPE(ED_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(ED_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] + TYPE(ED_ContinuousStateType) , DIMENSION(:,:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(ED_DiscreteStateType) , DIMENSION(:,:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(ED_ConstraintStateType) , DIMENSION(:,:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(ED_OtherStateType) , DIMENSION(:,:), ALLOCATABLE :: OtherSt !< Other states [-] + TYPE(ED_ParameterType) , DIMENSION(:), ALLOCATABLE :: p !< Parameters [-] + TYPE(ED_OutputType) , DIMENSION(:), ALLOCATABLE :: y !< System outputs [-] + TYPE(ED_MiscVarType) , DIMENSION(:), ALLOCATABLE :: m !< Misc (optimization) variables not associated with time [-] + 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 ! ======================= ! ========= SED_Data ======= TYPE, PUBLIC :: SED_Data - TYPE(SED_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(SED_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(SED_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(SED_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(SED_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(SED_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(SED_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(SED_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(SED_ParameterType) :: p !< Parameters [-] - TYPE(SED_InputType) :: u !< System inputs [-] TYPE(SED_OutputType) :: y !< System outputs [-] TYPE(SED_MiscVarType) :: m !< Misc (optimization) variables not associated with time [-] - TYPE(SED_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] - TYPE(SED_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(SED_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE SED_Data ! ======================= ! ========= ServoDyn_Data ======= TYPE, PUBLIC :: ServoDyn_Data - TYPE(SrvD_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(SrvD_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(SrvD_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(SrvD_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(SrvD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(SrvD_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(SrvD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(SrvD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(SrvD_ParameterType) :: p !< Parameters [-] - 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_MiscVarType) :: m_bak !< Backup 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 [-] - TYPE(SrvD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE ServoDyn_Data ! ======================= ! ========= AeroDyn_Data ======= TYPE, PUBLIC :: AeroDyn_Data - TYPE(AD_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(AD_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(AD_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(AD_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(AD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(AD_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(AD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(AD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(AD_ParameterType) :: p !< Parameters [-] - 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 [-] - TYPE(AD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE AeroDyn_Data ! ======================= ! ========= ExtLoads_Data ======= @@ -521,36 +421,28 @@ MODULE FAST_Types ! ======================= ! ========= AeroDisk_Data ======= TYPE, PUBLIC :: AeroDisk_Data - TYPE(ADsk_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(ADsk_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(ADsk_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(ADsk_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(ADsk_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(ADsk_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(ADsk_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(ADsk_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(ADsk_ParameterType) :: p !< Parameters [-] - TYPE(ADsk_InputType) :: u !< System inputs [-] TYPE(ADsk_OutputType) :: y !< System outputs [-] TYPE(ADsk_MiscVarType) :: m !< Misc/optimization variables [-] - TYPE(ADsk_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] - TYPE(ADsk_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(ADsk_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE AeroDisk_Data ! ======================= ! ========= InflowWind_Data ======= TYPE, PUBLIC :: InflowWind_Data - TYPE(InflowWind_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(InflowWind_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(InflowWind_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(InflowWind_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(InflowWind_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(InflowWind_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(InflowWind_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(InflowWind_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(InflowWind_ParameterType) :: p !< Parameters [-] - 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 [-] - TYPE(InflowWind_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE InflowWind_Data ! ======================= ! ========= ExternalInflow_Data ======= @@ -570,156 +462,122 @@ MODULE FAST_Types ! ======================= ! ========= SubDyn_Data ======= TYPE, PUBLIC :: SubDyn_Data - TYPE(SD_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(SD_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(SD_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(SD_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(SD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(SD_ContinuousStateType) :: dxdt !< Continuous state derivatives [-] + TYPE(SD_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(SD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(SD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(SD_ParameterType) :: p !< Parameters [-] - TYPE(SD_InputType) :: u !< System inputs [-] TYPE(SD_OutputType) :: y !< System outputs [-] TYPE(SD_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(SD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(SD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] - TYPE(SD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] - TYPE(SD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE SubDyn_Data ! ======================= ! ========= ExtPtfm_Data ======= TYPE, PUBLIC :: ExtPtfm_Data - TYPE(ExtPtfm_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(ExtPtfm_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(ExtPtfm_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(ExtPtfm_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(ExtPtfm_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(ExtPtfm_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(ExtPtfm_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(ExtPtfm_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(ExtPtfm_ParameterType) :: p !< Parameters [-] - TYPE(ExtPtfm_InputType) :: u !< System inputs [-] TYPE(ExtPtfm_OutputType) :: y !< System outputs [-] TYPE(ExtPtfm_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(ExtPtfm_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(ExtPtfm_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE ExtPtfm_Data ! ======================= ! ========= SeaState_Data ======= TYPE, PUBLIC :: SeaState_Data - TYPE(SeaSt_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(SeaSt_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(SeaSt_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(SeaSt_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(SeaSt_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(SeaSt_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(SeaSt_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(SeaSt_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(SeaSt_ParameterType) :: p !< Parameters [-] - TYPE(SeaSt_InputType) :: u !< System inputs [-] TYPE(SeaSt_OutputType) :: y !< System outputs [-] TYPE(SeaSt_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(SeaSt_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(SeaSt_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] - TYPE(SeaSt_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] - TYPE(SeaSt_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE SeaState_Data ! ======================= ! ========= HydroDyn_Data ======= TYPE, PUBLIC :: HydroDyn_Data - TYPE(HydroDyn_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(HydroDyn_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(HydroDyn_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(HydroDyn_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(HydroDyn_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(HydroDyn_ContinuousStateType) :: dxdt !< Continuous state derivatives [-] + TYPE(HydroDyn_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(HydroDyn_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(HydroDyn_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(HydroDyn_ParameterType) :: p !< Parameters [-] - 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 [-] - TYPE(HydroDyn_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE HydroDyn_Data ! ======================= ! ========= IceFloe_Data ======= TYPE, PUBLIC :: IceFloe_Data - TYPE(IceFloe_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(IceFloe_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(IceFloe_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(IceFloe_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(IceFloe_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(IceFloe_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(IceFloe_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(IceFloe_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(IceFloe_ParameterType) :: p !< Parameters [-] - TYPE(IceFloe_InputType) :: u !< System inputs [-] TYPE(IceFloe_OutputType) :: y !< System outputs [-] TYPE(IceFloe_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(IceFloe_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(IceFloe_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE IceFloe_Data ! ======================= ! ========= MAP_Data ======= TYPE, PUBLIC :: MAP_Data - TYPE(MAP_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(MAP_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(MAP_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] + TYPE(MAP_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(MAP_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(MAP_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] TYPE(MAP_OtherStateType) :: OtherSt !< Other/optimization states [-] TYPE(MAP_ParameterType) :: p !< Parameters [-] - TYPE(MAP_InputType) :: u !< System inputs [-] TYPE(MAP_OutputType) :: y !< System outputs [-] + TYPE(MAP_MiscVarType) :: m !< Misc/optimization variables [-] 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 [-] - TYPE(MAP_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE MAP_Data ! ======================= ! ========= FEAMooring_Data ======= TYPE, PUBLIC :: FEAMooring_Data - TYPE(FEAM_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(FEAM_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(FEAM_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(FEAM_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(FEAM_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(FEAM_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(FEAM_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(FEAM_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(FEAM_ParameterType) :: p !< Parameters [-] - TYPE(FEAM_InputType) :: u !< System inputs [-] TYPE(FEAM_OutputType) :: y !< System outputs [-] TYPE(FEAM_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(FEAM_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(FEAM_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE FEAMooring_Data ! ======================= ! ========= MoorDyn_Data ======= TYPE, PUBLIC :: MoorDyn_Data - TYPE(MD_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(MD_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(MD_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(MD_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(MD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(MD_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(MD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(MD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(MD_ParameterType) :: p !< Parameters [-] - TYPE(MD_InputType) :: u !< System inputs [-] TYPE(MD_OutputType) :: y !< System outputs [-] TYPE(MD_MiscVarType) :: m !< Misc/optimization variables [-] - TYPE(MD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] - TYPE(MD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(MD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(MD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE MoorDyn_Data ! ======================= ! ========= OrcaFlex_Data ======= TYPE, PUBLIC :: OrcaFlex_Data - TYPE(Orca_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] - TYPE(Orca_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] - TYPE(Orca_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] - TYPE(Orca_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(Orca_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(Orca_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(Orca_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(Orca_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt !< Other states [-] TYPE(Orca_ParameterType) :: p !< Parameters [-] - TYPE(Orca_InputType) :: u !< System inputs [-] TYPE(Orca_OutputType) :: y !< System outputs [-] TYPE(Orca_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(Orca_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(Orca_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE OrcaFlex_Data ! ======================= ! ========= FAST_ModuleMapType ======= @@ -838,7 +696,7 @@ MODULE FAST_Types ! ========= 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(ED_InitOutputType) , DIMENSION(:), ALLOCATABLE :: OutData_ED !< ED Initialization output data [-] TYPE(SED_InitInputType) :: InData_SED !< SED Initialization input data [-] TYPE(SED_InitOutputType) :: OutData_SED !< SED Initialization output data [-] TYPE(BD_InitInputType) :: InData_BD !< BD Initialization input data [-] @@ -909,6 +767,9 @@ MODULE FAST_Types TYPE(FAST_ParameterType) :: p_FAST !< Parameters for the glue code [-] TYPE(FAST_OutputFileType) :: y_FAST !< Output variables for the glue code [-] TYPE(FAST_MiscVarType) :: m_FAST !< Miscellaneous variables [-] + TYPE(Glue_ParameterType) :: p_Glue !< Parameters for the glue code [-] + TYPE(Glue_OutputFileType) :: y_Glue !< Output variables for the glue code [-] + TYPE(Glue_MiscVarType) :: m_Glue !< Miscellaneous variables [-] TYPE(FAST_ModuleMapType) :: MeshMapData !< Data for mapping between modules [-] TYPE(ElastoDyn_Data) :: ED !< Data for the ElastoDyn module [-] TYPE(SED_Data) :: SED !< Data for the Simplified-ElastoDyn module [-] @@ -932,7 +793,8 @@ MODULE FAST_Types TYPE(ExtPtfm_Data) :: ExtPtfm !< Data for the ExtPtfm (external platform loading) module [-] END TYPE FAST_TurbineType ! ======================= -CONTAINS + +contains subroutine FAST_CopyVTK_BLSurfaceType(SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfaceTypeData, CtrlCode, ErrStat, ErrMsg) type(FAST_VTK_BLSurfaceType), intent(in) :: SrcVTK_BLSurfaceTypeData @@ -1421,6 +1283,9 @@ subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nBeams = SrcParamData%nBeams DstParamData%BD_OutputSibling = SrcParamData%BD_OutputSibling DstParamData%ModuleInitialized = SrcParamData%ModuleInitialized + DstParamData%RhoInf = SrcParamData%RhoInf + DstParamData%ConvTol = SrcParamData%ConvTol + DstParamData%MaxConvIter = SrcParamData%MaxConvIter DstParamData%DT_Ujac = SrcParamData%DT_Ujac DstParamData%UJacSclFact = SrcParamData%UJacSclFact DstParamData%SizeJac_Opt1 = SrcParamData%SizeJac_Opt1 @@ -1593,6 +1458,9 @@ subroutine FAST_PackParam(RF, Indata) call RegPack(RF, InData%nBeams) call RegPack(RF, InData%BD_OutputSibling) call RegPack(RF, InData%ModuleInitialized) + call RegPack(RF, InData%RhoInf) + call RegPack(RF, InData%ConvTol) + call RegPack(RF, InData%MaxConvIter) call RegPack(RF, InData%DT_Ujac) call RegPack(RF, InData%UJacSclFact) call RegPack(RF, InData%SizeJac_Opt1) @@ -1708,6 +1576,9 @@ subroutine FAST_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%nBeams); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%BD_OutputSibling); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%ModuleInitialized); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RhoInf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ConvTol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MaxConvIter); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DT_Ujac); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%UJacSclFact); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SizeJac_Opt1); if (RegCheckErr(RF, RoutineName)) return @@ -1802,3660 +1673,264 @@ subroutine FAST_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%GearBox_index); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlCode, ErrStat, ErrMsg) - type(FAST_LinStateSave), intent(inout) :: SrcLinStateSaveData - type(FAST_LinStateSave), intent(inout) :: DstLinStateSaveData +subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_LinType), intent(in) :: SrcLinTypeData + type(FAST_LinType), intent(inout) :: DstLinTypeData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2 integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'FAST_CopyLinStateSave' + character(*), parameter :: RoutineName = 'FAST_CopyLinType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcLinStateSaveData%x_IceD)) then - LB(1:2) = lbound(SrcLinStateSaveData%x_IceD) - UB(1:2) = ubound(SrcLinStateSaveData%x_IceD) - if (.not. allocated(DstLinStateSaveData%x_IceD)) then - allocate(DstLinStateSaveData%x_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcLinTypeData%Names_u)) then + LB(1:1) = lbound(SrcLinTypeData%Names_u) + UB(1:1) = ubound(SrcLinTypeData%Names_u) + if (.not. allocated(DstLinTypeData%Names_u)) then + allocate(DstLinTypeData%Names_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IceD.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_u.', ErrStat, ErrMsg, RoutineName) return end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_CopyContState(SrcLinStateSaveData%x_IceD(i1,i2), DstLinStateSaveData%x_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do + DstLinTypeData%Names_u = SrcLinTypeData%Names_u end if - if (allocated(SrcLinStateSaveData%xd_IceD)) then - LB(1:2) = lbound(SrcLinStateSaveData%xd_IceD) - UB(1:2) = ubound(SrcLinStateSaveData%xd_IceD) - if (.not. allocated(DstLinStateSaveData%xd_IceD)) then - allocate(DstLinStateSaveData%xd_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcLinTypeData%Names_y)) then + LB(1:1) = lbound(SrcLinTypeData%Names_y) + UB(1:1) = ubound(SrcLinTypeData%Names_y) + if (.not. allocated(DstLinTypeData%Names_y)) then + allocate(DstLinTypeData%Names_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IceD.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_y.', ErrStat, ErrMsg, RoutineName) return end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_CopyDiscState(SrcLinStateSaveData%xd_IceD(i1,i2), DstLinStateSaveData%xd_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do + DstLinTypeData%Names_y = SrcLinTypeData%Names_y end if - if (allocated(SrcLinStateSaveData%z_IceD)) then - LB(1:2) = lbound(SrcLinStateSaveData%z_IceD) - UB(1:2) = ubound(SrcLinStateSaveData%z_IceD) - if (.not. allocated(DstLinStateSaveData%z_IceD)) then - allocate(DstLinStateSaveData%z_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcLinTypeData%Names_x)) then + LB(1:1) = lbound(SrcLinTypeData%Names_x) + UB(1:1) = ubound(SrcLinTypeData%Names_x) + if (.not. allocated(DstLinTypeData%Names_x)) then + allocate(DstLinTypeData%Names_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IceD.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_x.', ErrStat, ErrMsg, RoutineName) return end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_CopyConstrState(SrcLinStateSaveData%z_IceD(i1,i2), DstLinStateSaveData%z_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do + DstLinTypeData%Names_x = SrcLinTypeData%Names_x end if - if (allocated(SrcLinStateSaveData%OtherSt_IceD)) then - LB(1:2) = lbound(SrcLinStateSaveData%OtherSt_IceD) - UB(1:2) = ubound(SrcLinStateSaveData%OtherSt_IceD) - if (.not. allocated(DstLinStateSaveData%OtherSt_IceD)) then - allocate(DstLinStateSaveData%OtherSt_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcLinTypeData%Names_xd)) then + LB(1:1) = lbound(SrcLinTypeData%Names_xd) + UB(1:1) = ubound(SrcLinTypeData%Names_xd) + if (.not. allocated(DstLinTypeData%Names_xd)) then + allocate(DstLinTypeData%Names_xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IceD.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_xd.', ErrStat, ErrMsg, RoutineName) return end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_CopyOtherState(SrcLinStateSaveData%OtherSt_IceD(i1,i2), DstLinStateSaveData%OtherSt_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do + DstLinTypeData%Names_xd = SrcLinTypeData%Names_xd end if - if (allocated(SrcLinStateSaveData%u_IceD)) then - LB(1:2) = lbound(SrcLinStateSaveData%u_IceD) - UB(1:2) = ubound(SrcLinStateSaveData%u_IceD) - if (.not. allocated(DstLinStateSaveData%u_IceD)) then - allocate(DstLinStateSaveData%u_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcLinTypeData%Names_z)) then + LB(1:1) = lbound(SrcLinTypeData%Names_z) + UB(1:1) = ubound(SrcLinTypeData%Names_z) + if (.not. allocated(DstLinTypeData%Names_z)) then + allocate(DstLinTypeData%Names_z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IceD.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_z.', ErrStat, ErrMsg, RoutineName) return end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_CopyInput(SrcLinStateSaveData%u_IceD(i1,i2), DstLinStateSaveData%u_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do + DstLinTypeData%Names_z = SrcLinTypeData%Names_z end if - if (allocated(SrcLinStateSaveData%x_BD)) then - LB(1:2) = lbound(SrcLinStateSaveData%x_BD) - UB(1:2) = ubound(SrcLinStateSaveData%x_BD) - if (.not. allocated(DstLinStateSaveData%x_BD)) then - allocate(DstLinStateSaveData%x_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcLinTypeData%op_u)) then + LB(1:1) = lbound(SrcLinTypeData%op_u) + UB(1:1) = ubound(SrcLinTypeData%op_u) + if (.not. allocated(DstLinTypeData%op_u)) then + allocate(DstLinTypeData%op_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_BD.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_u.', ErrStat, ErrMsg, RoutineName) return end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_CopyContState(SrcLinStateSaveData%x_BD(i1,i2), DstLinStateSaveData%x_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do + DstLinTypeData%op_u = SrcLinTypeData%op_u end if - if (allocated(SrcLinStateSaveData%xd_BD)) then - LB(1:2) = lbound(SrcLinStateSaveData%xd_BD) - UB(1:2) = ubound(SrcLinStateSaveData%xd_BD) - if (.not. allocated(DstLinStateSaveData%xd_BD)) then - allocate(DstLinStateSaveData%xd_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcLinTypeData%op_y)) then + LB(1:1) = lbound(SrcLinTypeData%op_y) + UB(1:1) = ubound(SrcLinTypeData%op_y) + if (.not. allocated(DstLinTypeData%op_y)) then + allocate(DstLinTypeData%op_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_BD.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_y.', ErrStat, ErrMsg, RoutineName) return end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_CopyDiscState(SrcLinStateSaveData%xd_BD(i1,i2), DstLinStateSaveData%xd_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do + DstLinTypeData%op_y = SrcLinTypeData%op_y end if - if (allocated(SrcLinStateSaveData%z_BD)) then - LB(1:2) = lbound(SrcLinStateSaveData%z_BD) - UB(1:2) = ubound(SrcLinStateSaveData%z_BD) - if (.not. allocated(DstLinStateSaveData%z_BD)) then - allocate(DstLinStateSaveData%z_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcLinTypeData%op_x)) then + LB(1:1) = lbound(SrcLinTypeData%op_x) + UB(1:1) = ubound(SrcLinTypeData%op_x) + if (.not. allocated(DstLinTypeData%op_x)) then + allocate(DstLinTypeData%op_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_BD.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x.', ErrStat, ErrMsg, RoutineName) return end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_CopyConstrState(SrcLinStateSaveData%z_BD(i1,i2), DstLinStateSaveData%z_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do + DstLinTypeData%op_x = SrcLinTypeData%op_x end if - if (allocated(SrcLinStateSaveData%OtherSt_BD)) then - LB(1:2) = lbound(SrcLinStateSaveData%OtherSt_BD) - UB(1:2) = ubound(SrcLinStateSaveData%OtherSt_BD) - if (.not. allocated(DstLinStateSaveData%OtherSt_BD)) then - allocate(DstLinStateSaveData%OtherSt_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcLinTypeData%op_dx)) then + LB(1:1) = lbound(SrcLinTypeData%op_dx) + UB(1:1) = ubound(SrcLinTypeData%op_dx) + if (.not. allocated(DstLinTypeData%op_dx)) then + allocate(DstLinTypeData%op_dx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_BD.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_dx.', ErrStat, ErrMsg, RoutineName) return end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_CopyOtherState(SrcLinStateSaveData%OtherSt_BD(i1,i2), DstLinStateSaveData%OtherSt_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do + DstLinTypeData%op_dx = SrcLinTypeData%op_dx end if - if (allocated(SrcLinStateSaveData%u_BD)) then - LB(1:2) = lbound(SrcLinStateSaveData%u_BD) - UB(1:2) = ubound(SrcLinStateSaveData%u_BD) - if (.not. allocated(DstLinStateSaveData%u_BD)) then - allocate(DstLinStateSaveData%u_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcLinTypeData%op_xd)) then + LB(1:1) = lbound(SrcLinTypeData%op_xd) + UB(1:1) = ubound(SrcLinTypeData%op_xd) + if (.not. allocated(DstLinTypeData%op_xd)) then + allocate(DstLinTypeData%op_xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_BD.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_xd.', ErrStat, ErrMsg, RoutineName) return end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_CopyInput(SrcLinStateSaveData%u_BD(i1,i2), DstLinStateSaveData%u_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do + DstLinTypeData%op_xd = SrcLinTypeData%op_xd end if - if (allocated(SrcLinStateSaveData%x_ED)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_ED) - UB(1:1) = ubound(SrcLinStateSaveData%x_ED) - if (.not. allocated(DstLinStateSaveData%x_ED)) then - allocate(DstLinStateSaveData%x_ED(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcLinTypeData%op_z)) then + LB(1:1) = lbound(SrcLinTypeData%op_z) + UB(1:1) = ubound(SrcLinTypeData%op_z) + if (.not. allocated(DstLinTypeData%op_z)) then + allocate(DstLinTypeData%op_z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_ED.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_z.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call ED_CopyContState(SrcLinStateSaveData%x_ED(i1), DstLinStateSaveData%x_ED(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstLinTypeData%op_z = SrcLinTypeData%op_z end if - if (allocated(SrcLinStateSaveData%xd_ED)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_ED) - UB(1:1) = ubound(SrcLinStateSaveData%xd_ED) - if (.not. allocated(DstLinStateSaveData%xd_ED)) then - allocate(DstLinStateSaveData%xd_ED(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcLinTypeData%op_x_eig_mag)) then + LB(1:1) = lbound(SrcLinTypeData%op_x_eig_mag) + UB(1:1) = ubound(SrcLinTypeData%op_x_eig_mag) + if (.not. allocated(DstLinTypeData%op_x_eig_mag)) then + allocate(DstLinTypeData%op_x_eig_mag(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_ED.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_mag.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call ED_CopyDiscState(SrcLinStateSaveData%xd_ED(i1), DstLinStateSaveData%xd_ED(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstLinTypeData%op_x_eig_mag = SrcLinTypeData%op_x_eig_mag end if - if (allocated(SrcLinStateSaveData%z_ED)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_ED) - UB(1:1) = ubound(SrcLinStateSaveData%z_ED) - if (.not. allocated(DstLinStateSaveData%z_ED)) then - allocate(DstLinStateSaveData%z_ED(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcLinTypeData%op_x_eig_phase)) then + LB(1:1) = lbound(SrcLinTypeData%op_x_eig_phase) + UB(1:1) = ubound(SrcLinTypeData%op_x_eig_phase) + if (.not. allocated(DstLinTypeData%op_x_eig_phase)) then + allocate(DstLinTypeData%op_x_eig_phase(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_ED.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_phase.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call ED_CopyConstrState(SrcLinStateSaveData%z_ED(i1), DstLinStateSaveData%z_ED(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstLinTypeData%op_x_eig_phase = SrcLinTypeData%op_x_eig_phase end if - if (allocated(SrcLinStateSaveData%OtherSt_ED)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_ED) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_ED) - if (.not. allocated(DstLinStateSaveData%OtherSt_ED)) then - allocate(DstLinStateSaveData%OtherSt_ED(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcLinTypeData%Use_u)) then + LB(1:1) = lbound(SrcLinTypeData%Use_u) + UB(1:1) = ubound(SrcLinTypeData%Use_u) + if (.not. allocated(DstLinTypeData%Use_u)) then + allocate(DstLinTypeData%Use_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_ED.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_u.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call ED_CopyOtherState(SrcLinStateSaveData%OtherSt_ED(i1), DstLinStateSaveData%OtherSt_ED(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstLinTypeData%Use_u = SrcLinTypeData%Use_u end if - if (allocated(SrcLinStateSaveData%u_ED)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_ED) - UB(1:1) = ubound(SrcLinStateSaveData%u_ED) - if (.not. allocated(DstLinStateSaveData%u_ED)) then - allocate(DstLinStateSaveData%u_ED(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcLinTypeData%Use_y)) then + LB(1:1) = lbound(SrcLinTypeData%Use_y) + UB(1:1) = ubound(SrcLinTypeData%Use_y) + if (.not. allocated(DstLinTypeData%Use_y)) then + allocate(DstLinTypeData%Use_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_ED.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_y.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call ED_CopyInput(SrcLinStateSaveData%u_ED(i1), DstLinStateSaveData%u_ED(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstLinTypeData%Use_y = SrcLinTypeData%Use_y end if - if (allocated(SrcLinStateSaveData%x_SrvD)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_SrvD) - UB(1:1) = ubound(SrcLinStateSaveData%x_SrvD) - if (.not. allocated(DstLinStateSaveData%x_SrvD)) then - allocate(DstLinStateSaveData%x_SrvD(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcLinTypeData%A)) then + LB(1:2) = lbound(SrcLinTypeData%A) + UB(1:2) = ubound(SrcLinTypeData%A) + if (.not. allocated(DstLinTypeData%A)) then + allocate(DstLinTypeData%A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SrvD.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%A.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call SrvD_CopyContState(SrcLinStateSaveData%x_SrvD(i1), DstLinStateSaveData%x_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstLinTypeData%A = SrcLinTypeData%A end if - if (allocated(SrcLinStateSaveData%xd_SrvD)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_SrvD) - UB(1:1) = ubound(SrcLinStateSaveData%xd_SrvD) - if (.not. allocated(DstLinStateSaveData%xd_SrvD)) then - allocate(DstLinStateSaveData%xd_SrvD(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcLinTypeData%B)) then + LB(1:2) = lbound(SrcLinTypeData%B) + UB(1:2) = ubound(SrcLinTypeData%B) + if (.not. allocated(DstLinTypeData%B)) then + allocate(DstLinTypeData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SrvD.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%B.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call SrvD_CopyDiscState(SrcLinStateSaveData%xd_SrvD(i1), DstLinStateSaveData%xd_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstLinTypeData%B = SrcLinTypeData%B end if - if (allocated(SrcLinStateSaveData%z_SrvD)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_SrvD) - UB(1:1) = ubound(SrcLinStateSaveData%z_SrvD) - if (.not. allocated(DstLinStateSaveData%z_SrvD)) then - allocate(DstLinStateSaveData%z_SrvD(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcLinTypeData%C)) then + LB(1:2) = lbound(SrcLinTypeData%C) + UB(1:2) = ubound(SrcLinTypeData%C) + if (.not. allocated(DstLinTypeData%C)) then + allocate(DstLinTypeData%C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SrvD.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%C.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call SrvD_CopyConstrState(SrcLinStateSaveData%z_SrvD(i1), DstLinStateSaveData%z_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstLinTypeData%C = SrcLinTypeData%C end if - if (allocated(SrcLinStateSaveData%OtherSt_SrvD)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_SrvD) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_SrvD) - if (.not. allocated(DstLinStateSaveData%OtherSt_SrvD)) then - allocate(DstLinStateSaveData%OtherSt_SrvD(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcLinTypeData%D)) then + LB(1:2) = lbound(SrcLinTypeData%D) + UB(1:2) = ubound(SrcLinTypeData%D) + if (.not. allocated(DstLinTypeData%D)) then + allocate(DstLinTypeData%D(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SrvD.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%D.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call SrvD_CopyOtherState(SrcLinStateSaveData%OtherSt_SrvD(i1), DstLinStateSaveData%OtherSt_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstLinTypeData%D = SrcLinTypeData%D end if - if (allocated(SrcLinStateSaveData%u_SrvD)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_SrvD) - UB(1:1) = ubound(SrcLinStateSaveData%u_SrvD) - if (.not. allocated(DstLinStateSaveData%u_SrvD)) then - allocate(DstLinStateSaveData%u_SrvD(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcLinTypeData%StateRotation)) then + LB(1:2) = lbound(SrcLinTypeData%StateRotation) + UB(1:2) = ubound(SrcLinTypeData%StateRotation) + if (.not. allocated(DstLinTypeData%StateRotation)) then + allocate(DstLinTypeData%StateRotation(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SrvD.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRotation.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call SrvD_CopyInput(SrcLinStateSaveData%u_SrvD(i1), DstLinStateSaveData%u_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstLinTypeData%StateRotation = SrcLinTypeData%StateRotation end if - if (allocated(SrcLinStateSaveData%x_AD)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_AD) - UB(1:1) = ubound(SrcLinStateSaveData%x_AD) - if (.not. allocated(DstLinStateSaveData%x_AD)) then - allocate(DstLinStateSaveData%x_AD(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcLinTypeData%IsLoad_u)) then + LB(1:1) = lbound(SrcLinTypeData%IsLoad_u) + UB(1:1) = ubound(SrcLinTypeData%IsLoad_u) + if (.not. allocated(DstLinTypeData%IsLoad_u)) then + allocate(DstLinTypeData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_AD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call AD_CopyContState(SrcLinStateSaveData%x_AD(i1), DstLinStateSaveData%x_AD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%xd_AD)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_AD) - UB(1:1) = ubound(SrcLinStateSaveData%xd_AD) - if (.not. allocated(DstLinStateSaveData%xd_AD)) then - allocate(DstLinStateSaveData%xd_AD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_AD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call AD_CopyDiscState(SrcLinStateSaveData%xd_AD(i1), DstLinStateSaveData%xd_AD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%z_AD)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_AD) - UB(1:1) = ubound(SrcLinStateSaveData%z_AD) - if (.not. allocated(DstLinStateSaveData%z_AD)) then - allocate(DstLinStateSaveData%z_AD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_AD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call AD_CopyConstrState(SrcLinStateSaveData%z_AD(i1), DstLinStateSaveData%z_AD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%OtherSt_AD)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_AD) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_AD) - if (.not. allocated(DstLinStateSaveData%OtherSt_AD)) then - allocate(DstLinStateSaveData%OtherSt_AD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_AD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call AD_CopyOtherState(SrcLinStateSaveData%OtherSt_AD(i1), DstLinStateSaveData%OtherSt_AD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%u_AD)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_AD) - UB(1:1) = ubound(SrcLinStateSaveData%u_AD) - if (.not. allocated(DstLinStateSaveData%u_AD)) then - allocate(DstLinStateSaveData%u_AD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_AD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call AD_CopyInput(SrcLinStateSaveData%u_AD(i1), DstLinStateSaveData%u_AD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%x_IfW)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_IfW) - UB(1:1) = ubound(SrcLinStateSaveData%x_IfW) - if (.not. allocated(DstLinStateSaveData%x_IfW)) then - allocate(DstLinStateSaveData%x_IfW(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IfW.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call InflowWind_CopyContState(SrcLinStateSaveData%x_IfW(i1), DstLinStateSaveData%x_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%xd_IfW)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_IfW) - UB(1:1) = ubound(SrcLinStateSaveData%xd_IfW) - if (.not. allocated(DstLinStateSaveData%xd_IfW)) then - allocate(DstLinStateSaveData%xd_IfW(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IfW.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call InflowWind_CopyDiscState(SrcLinStateSaveData%xd_IfW(i1), DstLinStateSaveData%xd_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%z_IfW)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_IfW) - UB(1:1) = ubound(SrcLinStateSaveData%z_IfW) - if (.not. allocated(DstLinStateSaveData%z_IfW)) then - allocate(DstLinStateSaveData%z_IfW(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IfW.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call InflowWind_CopyConstrState(SrcLinStateSaveData%z_IfW(i1), DstLinStateSaveData%z_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%OtherSt_IfW)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_IfW) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_IfW) - if (.not. allocated(DstLinStateSaveData%OtherSt_IfW)) then - allocate(DstLinStateSaveData%OtherSt_IfW(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IfW.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call InflowWind_CopyOtherState(SrcLinStateSaveData%OtherSt_IfW(i1), DstLinStateSaveData%OtherSt_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%u_IfW)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_IfW) - UB(1:1) = ubound(SrcLinStateSaveData%u_IfW) - if (.not. allocated(DstLinStateSaveData%u_IfW)) then - allocate(DstLinStateSaveData%u_IfW(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IfW.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call InflowWind_CopyInput(SrcLinStateSaveData%u_IfW(i1), DstLinStateSaveData%u_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%x_SD)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_SD) - UB(1:1) = ubound(SrcLinStateSaveData%x_SD) - if (.not. allocated(DstLinStateSaveData%x_SD)) then - allocate(DstLinStateSaveData%x_SD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SD_CopyContState(SrcLinStateSaveData%x_SD(i1), DstLinStateSaveData%x_SD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%xd_SD)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_SD) - UB(1:1) = ubound(SrcLinStateSaveData%xd_SD) - if (.not. allocated(DstLinStateSaveData%xd_SD)) then - allocate(DstLinStateSaveData%xd_SD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SD_CopyDiscState(SrcLinStateSaveData%xd_SD(i1), DstLinStateSaveData%xd_SD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%z_SD)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_SD) - UB(1:1) = ubound(SrcLinStateSaveData%z_SD) - if (.not. allocated(DstLinStateSaveData%z_SD)) then - allocate(DstLinStateSaveData%z_SD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SD_CopyConstrState(SrcLinStateSaveData%z_SD(i1), DstLinStateSaveData%z_SD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%OtherSt_SD)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_SD) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_SD) - if (.not. allocated(DstLinStateSaveData%OtherSt_SD)) then - allocate(DstLinStateSaveData%OtherSt_SD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SD_CopyOtherState(SrcLinStateSaveData%OtherSt_SD(i1), DstLinStateSaveData%OtherSt_SD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%u_SD)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_SD) - UB(1:1) = ubound(SrcLinStateSaveData%u_SD) - if (.not. allocated(DstLinStateSaveData%u_SD)) then - allocate(DstLinStateSaveData%u_SD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SD_CopyInput(SrcLinStateSaveData%u_SD(i1), DstLinStateSaveData%u_SD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%x_ExtPtfm)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_ExtPtfm) - UB(1:1) = ubound(SrcLinStateSaveData%x_ExtPtfm) - if (.not. allocated(DstLinStateSaveData%x_ExtPtfm)) then - allocate(DstLinStateSaveData%x_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_ExtPtfm.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call ExtPtfm_CopyContState(SrcLinStateSaveData%x_ExtPtfm(i1), DstLinStateSaveData%x_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%xd_ExtPtfm)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_ExtPtfm) - UB(1:1) = ubound(SrcLinStateSaveData%xd_ExtPtfm) - if (.not. allocated(DstLinStateSaveData%xd_ExtPtfm)) then - allocate(DstLinStateSaveData%xd_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_ExtPtfm.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call ExtPtfm_CopyDiscState(SrcLinStateSaveData%xd_ExtPtfm(i1), DstLinStateSaveData%xd_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%z_ExtPtfm)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_ExtPtfm) - UB(1:1) = ubound(SrcLinStateSaveData%z_ExtPtfm) - if (.not. allocated(DstLinStateSaveData%z_ExtPtfm)) then - allocate(DstLinStateSaveData%z_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_ExtPtfm.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call ExtPtfm_CopyConstrState(SrcLinStateSaveData%z_ExtPtfm(i1), DstLinStateSaveData%z_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%OtherSt_ExtPtfm)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_ExtPtfm) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_ExtPtfm) - if (.not. allocated(DstLinStateSaveData%OtherSt_ExtPtfm)) then - allocate(DstLinStateSaveData%OtherSt_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_ExtPtfm.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call ExtPtfm_CopyOtherState(SrcLinStateSaveData%OtherSt_ExtPtfm(i1), DstLinStateSaveData%OtherSt_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%u_ExtPtfm)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_ExtPtfm) - UB(1:1) = ubound(SrcLinStateSaveData%u_ExtPtfm) - if (.not. allocated(DstLinStateSaveData%u_ExtPtfm)) then - allocate(DstLinStateSaveData%u_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_ExtPtfm.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call ExtPtfm_CopyInput(SrcLinStateSaveData%u_ExtPtfm(i1), DstLinStateSaveData%u_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%x_HD)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_HD) - UB(1:1) = ubound(SrcLinStateSaveData%x_HD) - if (.not. allocated(DstLinStateSaveData%x_HD)) then - allocate(DstLinStateSaveData%x_HD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_HD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call HydroDyn_CopyContState(SrcLinStateSaveData%x_HD(i1), DstLinStateSaveData%x_HD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%xd_HD)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_HD) - UB(1:1) = ubound(SrcLinStateSaveData%xd_HD) - if (.not. allocated(DstLinStateSaveData%xd_HD)) then - allocate(DstLinStateSaveData%xd_HD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_HD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call HydroDyn_CopyDiscState(SrcLinStateSaveData%xd_HD(i1), DstLinStateSaveData%xd_HD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%z_HD)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_HD) - UB(1:1) = ubound(SrcLinStateSaveData%z_HD) - if (.not. allocated(DstLinStateSaveData%z_HD)) then - allocate(DstLinStateSaveData%z_HD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_HD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call HydroDyn_CopyConstrState(SrcLinStateSaveData%z_HD(i1), DstLinStateSaveData%z_HD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%OtherSt_HD)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_HD) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_HD) - if (.not. allocated(DstLinStateSaveData%OtherSt_HD)) then - allocate(DstLinStateSaveData%OtherSt_HD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_HD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call HydroDyn_CopyOtherState(SrcLinStateSaveData%OtherSt_HD(i1), DstLinStateSaveData%OtherSt_HD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%u_HD)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_HD) - UB(1:1) = ubound(SrcLinStateSaveData%u_HD) - if (.not. allocated(DstLinStateSaveData%u_HD)) then - allocate(DstLinStateSaveData%u_HD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_HD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call HydroDyn_CopyInput(SrcLinStateSaveData%u_HD(i1), DstLinStateSaveData%u_HD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%x_SeaSt)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_SeaSt) - UB(1:1) = ubound(SrcLinStateSaveData%x_SeaSt) - if (.not. allocated(DstLinStateSaveData%x_SeaSt)) then - allocate(DstLinStateSaveData%x_SeaSt(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SeaSt.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SeaSt_CopyContState(SrcLinStateSaveData%x_SeaSt(i1), DstLinStateSaveData%x_SeaSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%xd_SeaSt)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_SeaSt) - UB(1:1) = ubound(SrcLinStateSaveData%xd_SeaSt) - if (.not. allocated(DstLinStateSaveData%xd_SeaSt)) then - allocate(DstLinStateSaveData%xd_SeaSt(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SeaSt.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SeaSt_CopyDiscState(SrcLinStateSaveData%xd_SeaSt(i1), DstLinStateSaveData%xd_SeaSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%z_SeaSt)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_SeaSt) - UB(1:1) = ubound(SrcLinStateSaveData%z_SeaSt) - if (.not. allocated(DstLinStateSaveData%z_SeaSt)) then - allocate(DstLinStateSaveData%z_SeaSt(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SeaSt.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SeaSt_CopyConstrState(SrcLinStateSaveData%z_SeaSt(i1), DstLinStateSaveData%z_SeaSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%OtherSt_SeaSt)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_SeaSt) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_SeaSt) - if (.not. allocated(DstLinStateSaveData%OtherSt_SeaSt)) then - allocate(DstLinStateSaveData%OtherSt_SeaSt(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SeaSt.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SeaSt_CopyOtherState(SrcLinStateSaveData%OtherSt_SeaSt(i1), DstLinStateSaveData%OtherSt_SeaSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%u_SeaSt)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_SeaSt) - UB(1:1) = ubound(SrcLinStateSaveData%u_SeaSt) - if (.not. allocated(DstLinStateSaveData%u_SeaSt)) then - allocate(DstLinStateSaveData%u_SeaSt(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SeaSt.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SeaSt_CopyInput(SrcLinStateSaveData%u_SeaSt(i1), DstLinStateSaveData%u_SeaSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%x_IceF)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_IceF) - UB(1:1) = ubound(SrcLinStateSaveData%x_IceF) - if (.not. allocated(DstLinStateSaveData%x_IceF)) then - allocate(DstLinStateSaveData%x_IceF(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IceF.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call IceFloe_CopyContState(SrcLinStateSaveData%x_IceF(i1), DstLinStateSaveData%x_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%xd_IceF)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_IceF) - UB(1:1) = ubound(SrcLinStateSaveData%xd_IceF) - if (.not. allocated(DstLinStateSaveData%xd_IceF)) then - allocate(DstLinStateSaveData%xd_IceF(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IceF.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call IceFloe_CopyDiscState(SrcLinStateSaveData%xd_IceF(i1), DstLinStateSaveData%xd_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%z_IceF)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_IceF) - UB(1:1) = ubound(SrcLinStateSaveData%z_IceF) - if (.not. allocated(DstLinStateSaveData%z_IceF)) then - allocate(DstLinStateSaveData%z_IceF(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IceF.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call IceFloe_CopyConstrState(SrcLinStateSaveData%z_IceF(i1), DstLinStateSaveData%z_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%OtherSt_IceF)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_IceF) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_IceF) - if (.not. allocated(DstLinStateSaveData%OtherSt_IceF)) then - allocate(DstLinStateSaveData%OtherSt_IceF(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IceF.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call IceFloe_CopyOtherState(SrcLinStateSaveData%OtherSt_IceF(i1), DstLinStateSaveData%OtherSt_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%u_IceF)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_IceF) - UB(1:1) = ubound(SrcLinStateSaveData%u_IceF) - if (.not. allocated(DstLinStateSaveData%u_IceF)) then - allocate(DstLinStateSaveData%u_IceF(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IceF.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call IceFloe_CopyInput(SrcLinStateSaveData%u_IceF(i1), DstLinStateSaveData%u_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%x_MAP)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_MAP) - UB(1:1) = ubound(SrcLinStateSaveData%x_MAP) - if (.not. allocated(DstLinStateSaveData%x_MAP)) then - allocate(DstLinStateSaveData%x_MAP(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_MAP.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MAP_CopyContState(SrcLinStateSaveData%x_MAP(i1), DstLinStateSaveData%x_MAP(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%xd_MAP)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_MAP) - UB(1:1) = ubound(SrcLinStateSaveData%xd_MAP) - if (.not. allocated(DstLinStateSaveData%xd_MAP)) then - allocate(DstLinStateSaveData%xd_MAP(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_MAP.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MAP_CopyDiscState(SrcLinStateSaveData%xd_MAP(i1), DstLinStateSaveData%xd_MAP(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%z_MAP)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_MAP) - UB(1:1) = ubound(SrcLinStateSaveData%z_MAP) - if (.not. allocated(DstLinStateSaveData%z_MAP)) then - allocate(DstLinStateSaveData%z_MAP(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_MAP.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MAP_CopyConstrState(SrcLinStateSaveData%z_MAP(i1), DstLinStateSaveData%z_MAP(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%u_MAP)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_MAP) - UB(1:1) = ubound(SrcLinStateSaveData%u_MAP) - if (.not. allocated(DstLinStateSaveData%u_MAP)) then - allocate(DstLinStateSaveData%u_MAP(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_MAP.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MAP_CopyInput(SrcLinStateSaveData%u_MAP(i1), DstLinStateSaveData%u_MAP(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%x_FEAM)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_FEAM) - UB(1:1) = ubound(SrcLinStateSaveData%x_FEAM) - if (.not. allocated(DstLinStateSaveData%x_FEAM)) then - allocate(DstLinStateSaveData%x_FEAM(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_FEAM.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call FEAM_CopyContState(SrcLinStateSaveData%x_FEAM(i1), DstLinStateSaveData%x_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%xd_FEAM)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_FEAM) - UB(1:1) = ubound(SrcLinStateSaveData%xd_FEAM) - if (.not. allocated(DstLinStateSaveData%xd_FEAM)) then - allocate(DstLinStateSaveData%xd_FEAM(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_FEAM.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call FEAM_CopyDiscState(SrcLinStateSaveData%xd_FEAM(i1), DstLinStateSaveData%xd_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%z_FEAM)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_FEAM) - UB(1:1) = ubound(SrcLinStateSaveData%z_FEAM) - if (.not. allocated(DstLinStateSaveData%z_FEAM)) then - allocate(DstLinStateSaveData%z_FEAM(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_FEAM.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call FEAM_CopyConstrState(SrcLinStateSaveData%z_FEAM(i1), DstLinStateSaveData%z_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%OtherSt_FEAM)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_FEAM) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_FEAM) - if (.not. allocated(DstLinStateSaveData%OtherSt_FEAM)) then - allocate(DstLinStateSaveData%OtherSt_FEAM(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_FEAM.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call FEAM_CopyOtherState(SrcLinStateSaveData%OtherSt_FEAM(i1), DstLinStateSaveData%OtherSt_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%u_FEAM)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_FEAM) - UB(1:1) = ubound(SrcLinStateSaveData%u_FEAM) - if (.not. allocated(DstLinStateSaveData%u_FEAM)) then - allocate(DstLinStateSaveData%u_FEAM(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_FEAM.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call FEAM_CopyInput(SrcLinStateSaveData%u_FEAM(i1), DstLinStateSaveData%u_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%x_MD)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_MD) - UB(1:1) = ubound(SrcLinStateSaveData%x_MD) - if (.not. allocated(DstLinStateSaveData%x_MD)) then - allocate(DstLinStateSaveData%x_MD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_MD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MD_CopyContState(SrcLinStateSaveData%x_MD(i1), DstLinStateSaveData%x_MD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%xd_MD)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_MD) - UB(1:1) = ubound(SrcLinStateSaveData%xd_MD) - if (.not. allocated(DstLinStateSaveData%xd_MD)) then - allocate(DstLinStateSaveData%xd_MD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_MD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MD_CopyDiscState(SrcLinStateSaveData%xd_MD(i1), DstLinStateSaveData%xd_MD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%z_MD)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_MD) - UB(1:1) = ubound(SrcLinStateSaveData%z_MD) - if (.not. allocated(DstLinStateSaveData%z_MD)) then - allocate(DstLinStateSaveData%z_MD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_MD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MD_CopyConstrState(SrcLinStateSaveData%z_MD(i1), DstLinStateSaveData%z_MD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%OtherSt_MD)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_MD) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_MD) - if (.not. allocated(DstLinStateSaveData%OtherSt_MD)) then - allocate(DstLinStateSaveData%OtherSt_MD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_MD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MD_CopyOtherState(SrcLinStateSaveData%OtherSt_MD(i1), DstLinStateSaveData%OtherSt_MD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcLinStateSaveData%u_MD)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_MD) - UB(1:1) = ubound(SrcLinStateSaveData%u_MD) - if (.not. allocated(DstLinStateSaveData%u_MD)) then - allocate(DstLinStateSaveData%u_MD(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_MD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MD_CopyInput(SrcLinStateSaveData%u_MD(i1), DstLinStateSaveData%u_MD(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if -end subroutine - -subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) - type(FAST_LinStateSave), intent(inout) :: LinStateSaveData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'FAST_DestroyLinStateSave' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(LinStateSaveData%x_IceD)) then - LB(1:2) = lbound(LinStateSaveData%x_IceD) - UB(1:2) = ubound(LinStateSaveData%x_IceD) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_DestroyContState(LinStateSaveData%x_IceD(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(LinStateSaveData%x_IceD) - end if - if (allocated(LinStateSaveData%xd_IceD)) then - LB(1:2) = lbound(LinStateSaveData%xd_IceD) - UB(1:2) = ubound(LinStateSaveData%xd_IceD) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_DestroyDiscState(LinStateSaveData%xd_IceD(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(LinStateSaveData%xd_IceD) - end if - if (allocated(LinStateSaveData%z_IceD)) then - LB(1:2) = lbound(LinStateSaveData%z_IceD) - UB(1:2) = ubound(LinStateSaveData%z_IceD) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_DestroyConstrState(LinStateSaveData%z_IceD(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(LinStateSaveData%z_IceD) - end if - if (allocated(LinStateSaveData%OtherSt_IceD)) then - LB(1:2) = lbound(LinStateSaveData%OtherSt_IceD) - UB(1:2) = ubound(LinStateSaveData%OtherSt_IceD) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_DestroyOtherState(LinStateSaveData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(LinStateSaveData%OtherSt_IceD) - end if - if (allocated(LinStateSaveData%u_IceD)) then - LB(1:2) = lbound(LinStateSaveData%u_IceD) - UB(1:2) = ubound(LinStateSaveData%u_IceD) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_DestroyInput(LinStateSaveData%u_IceD(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(LinStateSaveData%u_IceD) - end if - if (allocated(LinStateSaveData%x_BD)) then - LB(1:2) = lbound(LinStateSaveData%x_BD) - UB(1:2) = ubound(LinStateSaveData%x_BD) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_DestroyContState(LinStateSaveData%x_BD(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(LinStateSaveData%x_BD) - end if - if (allocated(LinStateSaveData%xd_BD)) then - LB(1:2) = lbound(LinStateSaveData%xd_BD) - UB(1:2) = ubound(LinStateSaveData%xd_BD) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_DestroyDiscState(LinStateSaveData%xd_BD(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(LinStateSaveData%xd_BD) - end if - if (allocated(LinStateSaveData%z_BD)) then - LB(1:2) = lbound(LinStateSaveData%z_BD) - UB(1:2) = ubound(LinStateSaveData%z_BD) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_DestroyConstrState(LinStateSaveData%z_BD(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(LinStateSaveData%z_BD) - end if - if (allocated(LinStateSaveData%OtherSt_BD)) then - LB(1:2) = lbound(LinStateSaveData%OtherSt_BD) - UB(1:2) = ubound(LinStateSaveData%OtherSt_BD) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_DestroyOtherState(LinStateSaveData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(LinStateSaveData%OtherSt_BD) - end if - if (allocated(LinStateSaveData%u_BD)) then - LB(1:2) = lbound(LinStateSaveData%u_BD) - UB(1:2) = ubound(LinStateSaveData%u_BD) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_DestroyInput(LinStateSaveData%u_BD(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(LinStateSaveData%u_BD) - end if - if (allocated(LinStateSaveData%x_ED)) then - LB(1:1) = lbound(LinStateSaveData%x_ED) - UB(1:1) = ubound(LinStateSaveData%x_ED) - do i1 = LB(1), UB(1) - call ED_DestroyContState(LinStateSaveData%x_ED(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_ED) - end if - if (allocated(LinStateSaveData%xd_ED)) then - LB(1:1) = lbound(LinStateSaveData%xd_ED) - UB(1:1) = ubound(LinStateSaveData%xd_ED) - do i1 = LB(1), UB(1) - call ED_DestroyDiscState(LinStateSaveData%xd_ED(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_ED) - end if - if (allocated(LinStateSaveData%z_ED)) then - LB(1:1) = lbound(LinStateSaveData%z_ED) - UB(1:1) = ubound(LinStateSaveData%z_ED) - do i1 = LB(1), UB(1) - call ED_DestroyConstrState(LinStateSaveData%z_ED(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_ED) - end if - if (allocated(LinStateSaveData%OtherSt_ED)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_ED) - UB(1:1) = ubound(LinStateSaveData%OtherSt_ED) - do i1 = LB(1), UB(1) - call ED_DestroyOtherState(LinStateSaveData%OtherSt_ED(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%OtherSt_ED) - end if - if (allocated(LinStateSaveData%u_ED)) then - LB(1:1) = lbound(LinStateSaveData%u_ED) - UB(1:1) = ubound(LinStateSaveData%u_ED) - do i1 = LB(1), UB(1) - call ED_DestroyInput(LinStateSaveData%u_ED(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_ED) - end if - if (allocated(LinStateSaveData%x_SrvD)) then - LB(1:1) = lbound(LinStateSaveData%x_SrvD) - UB(1:1) = ubound(LinStateSaveData%x_SrvD) - do i1 = LB(1), UB(1) - call SrvD_DestroyContState(LinStateSaveData%x_SrvD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_SrvD) - end if - if (allocated(LinStateSaveData%xd_SrvD)) then - LB(1:1) = lbound(LinStateSaveData%xd_SrvD) - UB(1:1) = ubound(LinStateSaveData%xd_SrvD) - do i1 = LB(1), UB(1) - call SrvD_DestroyDiscState(LinStateSaveData%xd_SrvD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_SrvD) - end if - if (allocated(LinStateSaveData%z_SrvD)) then - LB(1:1) = lbound(LinStateSaveData%z_SrvD) - UB(1:1) = ubound(LinStateSaveData%z_SrvD) - do i1 = LB(1), UB(1) - call SrvD_DestroyConstrState(LinStateSaveData%z_SrvD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_SrvD) - end if - if (allocated(LinStateSaveData%OtherSt_SrvD)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_SrvD) - UB(1:1) = ubound(LinStateSaveData%OtherSt_SrvD) - do i1 = LB(1), UB(1) - call SrvD_DestroyOtherState(LinStateSaveData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%OtherSt_SrvD) - end if - if (allocated(LinStateSaveData%u_SrvD)) then - LB(1:1) = lbound(LinStateSaveData%u_SrvD) - UB(1:1) = ubound(LinStateSaveData%u_SrvD) - do i1 = LB(1), UB(1) - call SrvD_DestroyInput(LinStateSaveData%u_SrvD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_SrvD) - end if - if (allocated(LinStateSaveData%x_AD)) then - LB(1:1) = lbound(LinStateSaveData%x_AD) - UB(1:1) = ubound(LinStateSaveData%x_AD) - do i1 = LB(1), UB(1) - call AD_DestroyContState(LinStateSaveData%x_AD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_AD) - end if - if (allocated(LinStateSaveData%xd_AD)) then - LB(1:1) = lbound(LinStateSaveData%xd_AD) - UB(1:1) = ubound(LinStateSaveData%xd_AD) - do i1 = LB(1), UB(1) - call AD_DestroyDiscState(LinStateSaveData%xd_AD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_AD) - end if - if (allocated(LinStateSaveData%z_AD)) then - LB(1:1) = lbound(LinStateSaveData%z_AD) - UB(1:1) = ubound(LinStateSaveData%z_AD) - do i1 = LB(1), UB(1) - call AD_DestroyConstrState(LinStateSaveData%z_AD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_AD) - end if - if (allocated(LinStateSaveData%OtherSt_AD)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_AD) - UB(1:1) = ubound(LinStateSaveData%OtherSt_AD) - do i1 = LB(1), UB(1) - call AD_DestroyOtherState(LinStateSaveData%OtherSt_AD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%OtherSt_AD) - end if - if (allocated(LinStateSaveData%u_AD)) then - LB(1:1) = lbound(LinStateSaveData%u_AD) - UB(1:1) = ubound(LinStateSaveData%u_AD) - do i1 = LB(1), UB(1) - call AD_DestroyInput(LinStateSaveData%u_AD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_AD) - end if - if (allocated(LinStateSaveData%x_IfW)) then - LB(1:1) = lbound(LinStateSaveData%x_IfW) - UB(1:1) = ubound(LinStateSaveData%x_IfW) - do i1 = LB(1), UB(1) - call InflowWind_DestroyContState(LinStateSaveData%x_IfW(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_IfW) - end if - if (allocated(LinStateSaveData%xd_IfW)) then - LB(1:1) = lbound(LinStateSaveData%xd_IfW) - UB(1:1) = ubound(LinStateSaveData%xd_IfW) - do i1 = LB(1), UB(1) - call InflowWind_DestroyDiscState(LinStateSaveData%xd_IfW(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_IfW) - end if - if (allocated(LinStateSaveData%z_IfW)) then - LB(1:1) = lbound(LinStateSaveData%z_IfW) - UB(1:1) = ubound(LinStateSaveData%z_IfW) - do i1 = LB(1), UB(1) - call InflowWind_DestroyConstrState(LinStateSaveData%z_IfW(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_IfW) - end if - if (allocated(LinStateSaveData%OtherSt_IfW)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_IfW) - UB(1:1) = ubound(LinStateSaveData%OtherSt_IfW) - do i1 = LB(1), UB(1) - call InflowWind_DestroyOtherState(LinStateSaveData%OtherSt_IfW(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%OtherSt_IfW) - end if - if (allocated(LinStateSaveData%u_IfW)) then - LB(1:1) = lbound(LinStateSaveData%u_IfW) - UB(1:1) = ubound(LinStateSaveData%u_IfW) - do i1 = LB(1), UB(1) - call InflowWind_DestroyInput(LinStateSaveData%u_IfW(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_IfW) - end if - if (allocated(LinStateSaveData%x_SD)) then - LB(1:1) = lbound(LinStateSaveData%x_SD) - UB(1:1) = ubound(LinStateSaveData%x_SD) - do i1 = LB(1), UB(1) - call SD_DestroyContState(LinStateSaveData%x_SD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_SD) - end if - if (allocated(LinStateSaveData%xd_SD)) then - LB(1:1) = lbound(LinStateSaveData%xd_SD) - UB(1:1) = ubound(LinStateSaveData%xd_SD) - do i1 = LB(1), UB(1) - call SD_DestroyDiscState(LinStateSaveData%xd_SD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_SD) - end if - if (allocated(LinStateSaveData%z_SD)) then - LB(1:1) = lbound(LinStateSaveData%z_SD) - UB(1:1) = ubound(LinStateSaveData%z_SD) - do i1 = LB(1), UB(1) - call SD_DestroyConstrState(LinStateSaveData%z_SD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_SD) - end if - if (allocated(LinStateSaveData%OtherSt_SD)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_SD) - UB(1:1) = ubound(LinStateSaveData%OtherSt_SD) - do i1 = LB(1), UB(1) - call SD_DestroyOtherState(LinStateSaveData%OtherSt_SD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%OtherSt_SD) - end if - if (allocated(LinStateSaveData%u_SD)) then - LB(1:1) = lbound(LinStateSaveData%u_SD) - UB(1:1) = ubound(LinStateSaveData%u_SD) - do i1 = LB(1), UB(1) - call SD_DestroyInput(LinStateSaveData%u_SD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_SD) - end if - if (allocated(LinStateSaveData%x_ExtPtfm)) then - LB(1:1) = lbound(LinStateSaveData%x_ExtPtfm) - UB(1:1) = ubound(LinStateSaveData%x_ExtPtfm) - do i1 = LB(1), UB(1) - call ExtPtfm_DestroyContState(LinStateSaveData%x_ExtPtfm(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_ExtPtfm) - end if - if (allocated(LinStateSaveData%xd_ExtPtfm)) then - LB(1:1) = lbound(LinStateSaveData%xd_ExtPtfm) - UB(1:1) = ubound(LinStateSaveData%xd_ExtPtfm) - do i1 = LB(1), UB(1) - call ExtPtfm_DestroyDiscState(LinStateSaveData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_ExtPtfm) - end if - if (allocated(LinStateSaveData%z_ExtPtfm)) then - LB(1:1) = lbound(LinStateSaveData%z_ExtPtfm) - UB(1:1) = ubound(LinStateSaveData%z_ExtPtfm) - do i1 = LB(1), UB(1) - call ExtPtfm_DestroyConstrState(LinStateSaveData%z_ExtPtfm(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_ExtPtfm) - end if - if (allocated(LinStateSaveData%OtherSt_ExtPtfm)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_ExtPtfm) - UB(1:1) = ubound(LinStateSaveData%OtherSt_ExtPtfm) - do i1 = LB(1), UB(1) - call ExtPtfm_DestroyOtherState(LinStateSaveData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%OtherSt_ExtPtfm) - end if - if (allocated(LinStateSaveData%u_ExtPtfm)) then - LB(1:1) = lbound(LinStateSaveData%u_ExtPtfm) - UB(1:1) = ubound(LinStateSaveData%u_ExtPtfm) - do i1 = LB(1), UB(1) - call ExtPtfm_DestroyInput(LinStateSaveData%u_ExtPtfm(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_ExtPtfm) - end if - if (allocated(LinStateSaveData%x_HD)) then - LB(1:1) = lbound(LinStateSaveData%x_HD) - UB(1:1) = ubound(LinStateSaveData%x_HD) - do i1 = LB(1), UB(1) - call HydroDyn_DestroyContState(LinStateSaveData%x_HD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_HD) - end if - if (allocated(LinStateSaveData%xd_HD)) then - LB(1:1) = lbound(LinStateSaveData%xd_HD) - UB(1:1) = ubound(LinStateSaveData%xd_HD) - do i1 = LB(1), UB(1) - call HydroDyn_DestroyDiscState(LinStateSaveData%xd_HD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_HD) - end if - if (allocated(LinStateSaveData%z_HD)) then - LB(1:1) = lbound(LinStateSaveData%z_HD) - UB(1:1) = ubound(LinStateSaveData%z_HD) - do i1 = LB(1), UB(1) - call HydroDyn_DestroyConstrState(LinStateSaveData%z_HD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_HD) - end if - if (allocated(LinStateSaveData%OtherSt_HD)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_HD) - UB(1:1) = ubound(LinStateSaveData%OtherSt_HD) - do i1 = LB(1), UB(1) - call HydroDyn_DestroyOtherState(LinStateSaveData%OtherSt_HD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%OtherSt_HD) - end if - if (allocated(LinStateSaveData%u_HD)) then - LB(1:1) = lbound(LinStateSaveData%u_HD) - UB(1:1) = ubound(LinStateSaveData%u_HD) - do i1 = LB(1), UB(1) - call HydroDyn_DestroyInput(LinStateSaveData%u_HD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_HD) - end if - if (allocated(LinStateSaveData%x_SeaSt)) then - LB(1:1) = lbound(LinStateSaveData%x_SeaSt) - UB(1:1) = ubound(LinStateSaveData%x_SeaSt) - do i1 = LB(1), UB(1) - call SeaSt_DestroyContState(LinStateSaveData%x_SeaSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_SeaSt) - end if - if (allocated(LinStateSaveData%xd_SeaSt)) then - LB(1:1) = lbound(LinStateSaveData%xd_SeaSt) - UB(1:1) = ubound(LinStateSaveData%xd_SeaSt) - do i1 = LB(1), UB(1) - call SeaSt_DestroyDiscState(LinStateSaveData%xd_SeaSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_SeaSt) - end if - if (allocated(LinStateSaveData%z_SeaSt)) then - LB(1:1) = lbound(LinStateSaveData%z_SeaSt) - UB(1:1) = ubound(LinStateSaveData%z_SeaSt) - do i1 = LB(1), UB(1) - call SeaSt_DestroyConstrState(LinStateSaveData%z_SeaSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_SeaSt) - end if - if (allocated(LinStateSaveData%OtherSt_SeaSt)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_SeaSt) - UB(1:1) = ubound(LinStateSaveData%OtherSt_SeaSt) - do i1 = LB(1), UB(1) - call SeaSt_DestroyOtherState(LinStateSaveData%OtherSt_SeaSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%OtherSt_SeaSt) - end if - if (allocated(LinStateSaveData%u_SeaSt)) then - LB(1:1) = lbound(LinStateSaveData%u_SeaSt) - UB(1:1) = ubound(LinStateSaveData%u_SeaSt) - do i1 = LB(1), UB(1) - call SeaSt_DestroyInput(LinStateSaveData%u_SeaSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_SeaSt) - end if - if (allocated(LinStateSaveData%x_IceF)) then - LB(1:1) = lbound(LinStateSaveData%x_IceF) - UB(1:1) = ubound(LinStateSaveData%x_IceF) - do i1 = LB(1), UB(1) - call IceFloe_DestroyContState(LinStateSaveData%x_IceF(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_IceF) - end if - if (allocated(LinStateSaveData%xd_IceF)) then - LB(1:1) = lbound(LinStateSaveData%xd_IceF) - UB(1:1) = ubound(LinStateSaveData%xd_IceF) - do i1 = LB(1), UB(1) - call IceFloe_DestroyDiscState(LinStateSaveData%xd_IceF(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_IceF) - end if - if (allocated(LinStateSaveData%z_IceF)) then - LB(1:1) = lbound(LinStateSaveData%z_IceF) - UB(1:1) = ubound(LinStateSaveData%z_IceF) - do i1 = LB(1), UB(1) - call IceFloe_DestroyConstrState(LinStateSaveData%z_IceF(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_IceF) - end if - if (allocated(LinStateSaveData%OtherSt_IceF)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_IceF) - UB(1:1) = ubound(LinStateSaveData%OtherSt_IceF) - do i1 = LB(1), UB(1) - call IceFloe_DestroyOtherState(LinStateSaveData%OtherSt_IceF(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%OtherSt_IceF) - end if - if (allocated(LinStateSaveData%u_IceF)) then - LB(1:1) = lbound(LinStateSaveData%u_IceF) - UB(1:1) = ubound(LinStateSaveData%u_IceF) - do i1 = LB(1), UB(1) - call IceFloe_DestroyInput(LinStateSaveData%u_IceF(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_IceF) - end if - if (allocated(LinStateSaveData%x_MAP)) then - LB(1:1) = lbound(LinStateSaveData%x_MAP) - UB(1:1) = ubound(LinStateSaveData%x_MAP) - do i1 = LB(1), UB(1) - call MAP_DestroyContState(LinStateSaveData%x_MAP(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_MAP) - end if - if (allocated(LinStateSaveData%xd_MAP)) then - LB(1:1) = lbound(LinStateSaveData%xd_MAP) - UB(1:1) = ubound(LinStateSaveData%xd_MAP) - do i1 = LB(1), UB(1) - call MAP_DestroyDiscState(LinStateSaveData%xd_MAP(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_MAP) - end if - if (allocated(LinStateSaveData%z_MAP)) then - LB(1:1) = lbound(LinStateSaveData%z_MAP) - UB(1:1) = ubound(LinStateSaveData%z_MAP) - do i1 = LB(1), UB(1) - call MAP_DestroyConstrState(LinStateSaveData%z_MAP(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_MAP) - end if - if (allocated(LinStateSaveData%u_MAP)) then - LB(1:1) = lbound(LinStateSaveData%u_MAP) - UB(1:1) = ubound(LinStateSaveData%u_MAP) - do i1 = LB(1), UB(1) - call MAP_DestroyInput(LinStateSaveData%u_MAP(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_MAP) - end if - if (allocated(LinStateSaveData%x_FEAM)) then - LB(1:1) = lbound(LinStateSaveData%x_FEAM) - UB(1:1) = ubound(LinStateSaveData%x_FEAM) - do i1 = LB(1), UB(1) - call FEAM_DestroyContState(LinStateSaveData%x_FEAM(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_FEAM) - end if - if (allocated(LinStateSaveData%xd_FEAM)) then - LB(1:1) = lbound(LinStateSaveData%xd_FEAM) - UB(1:1) = ubound(LinStateSaveData%xd_FEAM) - do i1 = LB(1), UB(1) - call FEAM_DestroyDiscState(LinStateSaveData%xd_FEAM(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_FEAM) - end if - if (allocated(LinStateSaveData%z_FEAM)) then - LB(1:1) = lbound(LinStateSaveData%z_FEAM) - UB(1:1) = ubound(LinStateSaveData%z_FEAM) - do i1 = LB(1), UB(1) - call FEAM_DestroyConstrState(LinStateSaveData%z_FEAM(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_FEAM) - end if - if (allocated(LinStateSaveData%OtherSt_FEAM)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_FEAM) - UB(1:1) = ubound(LinStateSaveData%OtherSt_FEAM) - do i1 = LB(1), UB(1) - call FEAM_DestroyOtherState(LinStateSaveData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%OtherSt_FEAM) - end if - if (allocated(LinStateSaveData%u_FEAM)) then - LB(1:1) = lbound(LinStateSaveData%u_FEAM) - UB(1:1) = ubound(LinStateSaveData%u_FEAM) - do i1 = LB(1), UB(1) - call FEAM_DestroyInput(LinStateSaveData%u_FEAM(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_FEAM) - end if - if (allocated(LinStateSaveData%x_MD)) then - LB(1:1) = lbound(LinStateSaveData%x_MD) - UB(1:1) = ubound(LinStateSaveData%x_MD) - do i1 = LB(1), UB(1) - call MD_DestroyContState(LinStateSaveData%x_MD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%x_MD) - end if - if (allocated(LinStateSaveData%xd_MD)) then - LB(1:1) = lbound(LinStateSaveData%xd_MD) - UB(1:1) = ubound(LinStateSaveData%xd_MD) - do i1 = LB(1), UB(1) - call MD_DestroyDiscState(LinStateSaveData%xd_MD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%xd_MD) - end if - if (allocated(LinStateSaveData%z_MD)) then - LB(1:1) = lbound(LinStateSaveData%z_MD) - UB(1:1) = ubound(LinStateSaveData%z_MD) - do i1 = LB(1), UB(1) - call MD_DestroyConstrState(LinStateSaveData%z_MD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%z_MD) - end if - if (allocated(LinStateSaveData%OtherSt_MD)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_MD) - UB(1:1) = ubound(LinStateSaveData%OtherSt_MD) - do i1 = LB(1), UB(1) - call MD_DestroyOtherState(LinStateSaveData%OtherSt_MD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%OtherSt_MD) - end if - if (allocated(LinStateSaveData%u_MD)) then - LB(1:1) = lbound(LinStateSaveData%u_MD) - UB(1:1) = ubound(LinStateSaveData%u_MD) - do i1 = LB(1), UB(1) - call MD_DestroyInput(LinStateSaveData%u_MD(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(LinStateSaveData%u_MD) - end if -end subroutine - -subroutine FAST_PackLinStateSave(RF, Indata) - type(RegFile), intent(inout) :: RF - type(FAST_LinStateSave), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackLinStateSave' - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, allocated(InData%x_IceD)) - if (allocated(InData%x_IceD)) then - call RegPackBounds(RF, 2, lbound(InData%x_IceD), ubound(InData%x_IceD)) - LB(1:2) = lbound(InData%x_IceD) - UB(1:2) = ubound(InData%x_IceD) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_PackContState(RF, InData%x_IceD(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%xd_IceD)) - if (allocated(InData%xd_IceD)) then - call RegPackBounds(RF, 2, lbound(InData%xd_IceD), ubound(InData%xd_IceD)) - LB(1:2) = lbound(InData%xd_IceD) - UB(1:2) = ubound(InData%xd_IceD) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_PackDiscState(RF, InData%xd_IceD(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%z_IceD)) - if (allocated(InData%z_IceD)) then - call RegPackBounds(RF, 2, lbound(InData%z_IceD), ubound(InData%z_IceD)) - LB(1:2) = lbound(InData%z_IceD) - UB(1:2) = ubound(InData%z_IceD) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_PackConstrState(RF, InData%z_IceD(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%OtherSt_IceD)) - if (allocated(InData%OtherSt_IceD)) then - call RegPackBounds(RF, 2, lbound(InData%OtherSt_IceD), ubound(InData%OtherSt_IceD)) - LB(1:2) = lbound(InData%OtherSt_IceD) - UB(1:2) = ubound(InData%OtherSt_IceD) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_PackOtherState(RF, InData%OtherSt_IceD(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%u_IceD)) - if (allocated(InData%u_IceD)) then - call RegPackBounds(RF, 2, lbound(InData%u_IceD), ubound(InData%u_IceD)) - LB(1:2) = lbound(InData%u_IceD) - UB(1:2) = ubound(InData%u_IceD) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_PackInput(RF, InData%u_IceD(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%x_BD)) - if (allocated(InData%x_BD)) then - call RegPackBounds(RF, 2, lbound(InData%x_BD), ubound(InData%x_BD)) - LB(1:2) = lbound(InData%x_BD) - UB(1:2) = ubound(InData%x_BD) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_PackContState(RF, InData%x_BD(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%xd_BD)) - if (allocated(InData%xd_BD)) then - call RegPackBounds(RF, 2, lbound(InData%xd_BD), ubound(InData%xd_BD)) - LB(1:2) = lbound(InData%xd_BD) - UB(1:2) = ubound(InData%xd_BD) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_PackDiscState(RF, InData%xd_BD(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%z_BD)) - if (allocated(InData%z_BD)) then - call RegPackBounds(RF, 2, lbound(InData%z_BD), ubound(InData%z_BD)) - LB(1:2) = lbound(InData%z_BD) - UB(1:2) = ubound(InData%z_BD) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_PackConstrState(RF, InData%z_BD(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%OtherSt_BD)) - if (allocated(InData%OtherSt_BD)) then - call RegPackBounds(RF, 2, lbound(InData%OtherSt_BD), ubound(InData%OtherSt_BD)) - LB(1:2) = lbound(InData%OtherSt_BD) - UB(1:2) = ubound(InData%OtherSt_BD) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_PackOtherState(RF, InData%OtherSt_BD(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%u_BD)) - if (allocated(InData%u_BD)) then - call RegPackBounds(RF, 2, lbound(InData%u_BD), ubound(InData%u_BD)) - LB(1:2) = lbound(InData%u_BD) - UB(1:2) = ubound(InData%u_BD) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_PackInput(RF, InData%u_BD(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%x_ED)) - if (allocated(InData%x_ED)) then - call RegPackBounds(RF, 1, lbound(InData%x_ED), ubound(InData%x_ED)) - LB(1:1) = lbound(InData%x_ED) - UB(1:1) = ubound(InData%x_ED) - do i1 = LB(1), UB(1) - call ED_PackContState(RF, InData%x_ED(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_ED)) - if (allocated(InData%xd_ED)) then - call RegPackBounds(RF, 1, lbound(InData%xd_ED), ubound(InData%xd_ED)) - LB(1:1) = lbound(InData%xd_ED) - UB(1:1) = ubound(InData%xd_ED) - do i1 = LB(1), UB(1) - call ED_PackDiscState(RF, InData%xd_ED(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_ED)) - if (allocated(InData%z_ED)) then - call RegPackBounds(RF, 1, lbound(InData%z_ED), ubound(InData%z_ED)) - LB(1:1) = lbound(InData%z_ED) - UB(1:1) = ubound(InData%z_ED) - do i1 = LB(1), UB(1) - call ED_PackConstrState(RF, InData%z_ED(i1)) - end do - end if - call RegPack(RF, allocated(InData%OtherSt_ED)) - if (allocated(InData%OtherSt_ED)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt_ED), ubound(InData%OtherSt_ED)) - LB(1:1) = lbound(InData%OtherSt_ED) - UB(1:1) = ubound(InData%OtherSt_ED) - do i1 = LB(1), UB(1) - call ED_PackOtherState(RF, InData%OtherSt_ED(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_ED)) - if (allocated(InData%u_ED)) then - call RegPackBounds(RF, 1, lbound(InData%u_ED), ubound(InData%u_ED)) - LB(1:1) = lbound(InData%u_ED) - UB(1:1) = ubound(InData%u_ED) - do i1 = LB(1), UB(1) - call ED_PackInput(RF, InData%u_ED(i1)) - end do - end if - call RegPack(RF, allocated(InData%x_SrvD)) - if (allocated(InData%x_SrvD)) then - call RegPackBounds(RF, 1, lbound(InData%x_SrvD), ubound(InData%x_SrvD)) - LB(1:1) = lbound(InData%x_SrvD) - UB(1:1) = ubound(InData%x_SrvD) - do i1 = LB(1), UB(1) - call SrvD_PackContState(RF, InData%x_SrvD(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_SrvD)) - if (allocated(InData%xd_SrvD)) then - call RegPackBounds(RF, 1, lbound(InData%xd_SrvD), ubound(InData%xd_SrvD)) - LB(1:1) = lbound(InData%xd_SrvD) - UB(1:1) = ubound(InData%xd_SrvD) - do i1 = LB(1), UB(1) - call SrvD_PackDiscState(RF, InData%xd_SrvD(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_SrvD)) - if (allocated(InData%z_SrvD)) then - call RegPackBounds(RF, 1, lbound(InData%z_SrvD), ubound(InData%z_SrvD)) - LB(1:1) = lbound(InData%z_SrvD) - UB(1:1) = ubound(InData%z_SrvD) - do i1 = LB(1), UB(1) - call SrvD_PackConstrState(RF, InData%z_SrvD(i1)) - end do - end if - call RegPack(RF, allocated(InData%OtherSt_SrvD)) - if (allocated(InData%OtherSt_SrvD)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt_SrvD), ubound(InData%OtherSt_SrvD)) - LB(1:1) = lbound(InData%OtherSt_SrvD) - UB(1:1) = ubound(InData%OtherSt_SrvD) - do i1 = LB(1), UB(1) - call SrvD_PackOtherState(RF, InData%OtherSt_SrvD(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_SrvD)) - if (allocated(InData%u_SrvD)) then - call RegPackBounds(RF, 1, lbound(InData%u_SrvD), ubound(InData%u_SrvD)) - LB(1:1) = lbound(InData%u_SrvD) - UB(1:1) = ubound(InData%u_SrvD) - do i1 = LB(1), UB(1) - call SrvD_PackInput(RF, InData%u_SrvD(i1)) - end do - end if - call RegPack(RF, allocated(InData%x_AD)) - if (allocated(InData%x_AD)) then - call RegPackBounds(RF, 1, lbound(InData%x_AD), ubound(InData%x_AD)) - LB(1:1) = lbound(InData%x_AD) - UB(1:1) = ubound(InData%x_AD) - do i1 = LB(1), UB(1) - call AD_PackContState(RF, InData%x_AD(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_AD)) - if (allocated(InData%xd_AD)) then - call RegPackBounds(RF, 1, lbound(InData%xd_AD), ubound(InData%xd_AD)) - LB(1:1) = lbound(InData%xd_AD) - UB(1:1) = ubound(InData%xd_AD) - do i1 = LB(1), UB(1) - call AD_PackDiscState(RF, InData%xd_AD(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_AD)) - if (allocated(InData%z_AD)) then - call RegPackBounds(RF, 1, lbound(InData%z_AD), ubound(InData%z_AD)) - LB(1:1) = lbound(InData%z_AD) - UB(1:1) = ubound(InData%z_AD) - do i1 = LB(1), UB(1) - call AD_PackConstrState(RF, InData%z_AD(i1)) - end do - end if - call RegPack(RF, allocated(InData%OtherSt_AD)) - if (allocated(InData%OtherSt_AD)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt_AD), ubound(InData%OtherSt_AD)) - LB(1:1) = lbound(InData%OtherSt_AD) - UB(1:1) = ubound(InData%OtherSt_AD) - do i1 = LB(1), UB(1) - call AD_PackOtherState(RF, InData%OtherSt_AD(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_AD)) - if (allocated(InData%u_AD)) then - call RegPackBounds(RF, 1, lbound(InData%u_AD), ubound(InData%u_AD)) - LB(1:1) = lbound(InData%u_AD) - UB(1:1) = ubound(InData%u_AD) - do i1 = LB(1), UB(1) - call AD_PackInput(RF, InData%u_AD(i1)) - end do - end if - call RegPack(RF, allocated(InData%x_IfW)) - if (allocated(InData%x_IfW)) then - call RegPackBounds(RF, 1, lbound(InData%x_IfW), ubound(InData%x_IfW)) - LB(1:1) = lbound(InData%x_IfW) - UB(1:1) = ubound(InData%x_IfW) - do i1 = LB(1), UB(1) - call InflowWind_PackContState(RF, InData%x_IfW(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_IfW)) - if (allocated(InData%xd_IfW)) then - call RegPackBounds(RF, 1, lbound(InData%xd_IfW), ubound(InData%xd_IfW)) - LB(1:1) = lbound(InData%xd_IfW) - UB(1:1) = ubound(InData%xd_IfW) - do i1 = LB(1), UB(1) - call InflowWind_PackDiscState(RF, InData%xd_IfW(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_IfW)) - if (allocated(InData%z_IfW)) then - call RegPackBounds(RF, 1, lbound(InData%z_IfW), ubound(InData%z_IfW)) - LB(1:1) = lbound(InData%z_IfW) - UB(1:1) = ubound(InData%z_IfW) - do i1 = LB(1), UB(1) - call InflowWind_PackConstrState(RF, InData%z_IfW(i1)) - end do - end if - call RegPack(RF, allocated(InData%OtherSt_IfW)) - if (allocated(InData%OtherSt_IfW)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt_IfW), ubound(InData%OtherSt_IfW)) - LB(1:1) = lbound(InData%OtherSt_IfW) - UB(1:1) = ubound(InData%OtherSt_IfW) - do i1 = LB(1), UB(1) - call InflowWind_PackOtherState(RF, InData%OtherSt_IfW(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_IfW)) - if (allocated(InData%u_IfW)) then - call RegPackBounds(RF, 1, lbound(InData%u_IfW), ubound(InData%u_IfW)) - LB(1:1) = lbound(InData%u_IfW) - UB(1:1) = ubound(InData%u_IfW) - do i1 = LB(1), UB(1) - call InflowWind_PackInput(RF, InData%u_IfW(i1)) - end do - end if - call RegPack(RF, allocated(InData%x_SD)) - if (allocated(InData%x_SD)) then - call RegPackBounds(RF, 1, lbound(InData%x_SD), ubound(InData%x_SD)) - LB(1:1) = lbound(InData%x_SD) - UB(1:1) = ubound(InData%x_SD) - do i1 = LB(1), UB(1) - call SD_PackContState(RF, InData%x_SD(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_SD)) - if (allocated(InData%xd_SD)) then - call RegPackBounds(RF, 1, lbound(InData%xd_SD), ubound(InData%xd_SD)) - LB(1:1) = lbound(InData%xd_SD) - UB(1:1) = ubound(InData%xd_SD) - do i1 = LB(1), UB(1) - call SD_PackDiscState(RF, InData%xd_SD(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_SD)) - if (allocated(InData%z_SD)) then - call RegPackBounds(RF, 1, lbound(InData%z_SD), ubound(InData%z_SD)) - LB(1:1) = lbound(InData%z_SD) - UB(1:1) = ubound(InData%z_SD) - do i1 = LB(1), UB(1) - call SD_PackConstrState(RF, InData%z_SD(i1)) - end do - end if - call RegPack(RF, allocated(InData%OtherSt_SD)) - if (allocated(InData%OtherSt_SD)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt_SD), ubound(InData%OtherSt_SD)) - LB(1:1) = lbound(InData%OtherSt_SD) - UB(1:1) = ubound(InData%OtherSt_SD) - do i1 = LB(1), UB(1) - call SD_PackOtherState(RF, InData%OtherSt_SD(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_SD)) - if (allocated(InData%u_SD)) then - call RegPackBounds(RF, 1, lbound(InData%u_SD), ubound(InData%u_SD)) - LB(1:1) = lbound(InData%u_SD) - UB(1:1) = ubound(InData%u_SD) - do i1 = LB(1), UB(1) - call SD_PackInput(RF, InData%u_SD(i1)) - end do - end if - call RegPack(RF, allocated(InData%x_ExtPtfm)) - if (allocated(InData%x_ExtPtfm)) then - call RegPackBounds(RF, 1, lbound(InData%x_ExtPtfm), ubound(InData%x_ExtPtfm)) - LB(1:1) = lbound(InData%x_ExtPtfm) - UB(1:1) = ubound(InData%x_ExtPtfm) - do i1 = LB(1), UB(1) - call ExtPtfm_PackContState(RF, InData%x_ExtPtfm(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_ExtPtfm)) - if (allocated(InData%xd_ExtPtfm)) then - call RegPackBounds(RF, 1, lbound(InData%xd_ExtPtfm), ubound(InData%xd_ExtPtfm)) - LB(1:1) = lbound(InData%xd_ExtPtfm) - UB(1:1) = ubound(InData%xd_ExtPtfm) - do i1 = LB(1), UB(1) - call ExtPtfm_PackDiscState(RF, InData%xd_ExtPtfm(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_ExtPtfm)) - if (allocated(InData%z_ExtPtfm)) then - call RegPackBounds(RF, 1, lbound(InData%z_ExtPtfm), ubound(InData%z_ExtPtfm)) - LB(1:1) = lbound(InData%z_ExtPtfm) - UB(1:1) = ubound(InData%z_ExtPtfm) - do i1 = LB(1), UB(1) - call ExtPtfm_PackConstrState(RF, InData%z_ExtPtfm(i1)) - end do - end if - call RegPack(RF, allocated(InData%OtherSt_ExtPtfm)) - if (allocated(InData%OtherSt_ExtPtfm)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt_ExtPtfm), ubound(InData%OtherSt_ExtPtfm)) - LB(1:1) = lbound(InData%OtherSt_ExtPtfm) - UB(1:1) = ubound(InData%OtherSt_ExtPtfm) - do i1 = LB(1), UB(1) - call ExtPtfm_PackOtherState(RF, InData%OtherSt_ExtPtfm(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_ExtPtfm)) - if (allocated(InData%u_ExtPtfm)) then - call RegPackBounds(RF, 1, lbound(InData%u_ExtPtfm), ubound(InData%u_ExtPtfm)) - LB(1:1) = lbound(InData%u_ExtPtfm) - UB(1:1) = ubound(InData%u_ExtPtfm) - do i1 = LB(1), UB(1) - call ExtPtfm_PackInput(RF, InData%u_ExtPtfm(i1)) - end do - end if - call RegPack(RF, allocated(InData%x_HD)) - if (allocated(InData%x_HD)) then - call RegPackBounds(RF, 1, lbound(InData%x_HD), ubound(InData%x_HD)) - LB(1:1) = lbound(InData%x_HD) - UB(1:1) = ubound(InData%x_HD) - do i1 = LB(1), UB(1) - call HydroDyn_PackContState(RF, InData%x_HD(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_HD)) - if (allocated(InData%xd_HD)) then - call RegPackBounds(RF, 1, lbound(InData%xd_HD), ubound(InData%xd_HD)) - LB(1:1) = lbound(InData%xd_HD) - UB(1:1) = ubound(InData%xd_HD) - do i1 = LB(1), UB(1) - call HydroDyn_PackDiscState(RF, InData%xd_HD(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_HD)) - if (allocated(InData%z_HD)) then - call RegPackBounds(RF, 1, lbound(InData%z_HD), ubound(InData%z_HD)) - LB(1:1) = lbound(InData%z_HD) - UB(1:1) = ubound(InData%z_HD) - do i1 = LB(1), UB(1) - call HydroDyn_PackConstrState(RF, InData%z_HD(i1)) - end do - end if - call RegPack(RF, allocated(InData%OtherSt_HD)) - if (allocated(InData%OtherSt_HD)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt_HD), ubound(InData%OtherSt_HD)) - LB(1:1) = lbound(InData%OtherSt_HD) - UB(1:1) = ubound(InData%OtherSt_HD) - do i1 = LB(1), UB(1) - call HydroDyn_PackOtherState(RF, InData%OtherSt_HD(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_HD)) - if (allocated(InData%u_HD)) then - call RegPackBounds(RF, 1, lbound(InData%u_HD), ubound(InData%u_HD)) - LB(1:1) = lbound(InData%u_HD) - UB(1:1) = ubound(InData%u_HD) - do i1 = LB(1), UB(1) - call HydroDyn_PackInput(RF, InData%u_HD(i1)) - end do - end if - call RegPack(RF, allocated(InData%x_SeaSt)) - if (allocated(InData%x_SeaSt)) then - call RegPackBounds(RF, 1, lbound(InData%x_SeaSt), ubound(InData%x_SeaSt)) - LB(1:1) = lbound(InData%x_SeaSt) - UB(1:1) = ubound(InData%x_SeaSt) - do i1 = LB(1), UB(1) - call SeaSt_PackContState(RF, InData%x_SeaSt(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_SeaSt)) - if (allocated(InData%xd_SeaSt)) then - call RegPackBounds(RF, 1, lbound(InData%xd_SeaSt), ubound(InData%xd_SeaSt)) - LB(1:1) = lbound(InData%xd_SeaSt) - UB(1:1) = ubound(InData%xd_SeaSt) - do i1 = LB(1), UB(1) - call SeaSt_PackDiscState(RF, InData%xd_SeaSt(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_SeaSt)) - if (allocated(InData%z_SeaSt)) then - call RegPackBounds(RF, 1, lbound(InData%z_SeaSt), ubound(InData%z_SeaSt)) - LB(1:1) = lbound(InData%z_SeaSt) - UB(1:1) = ubound(InData%z_SeaSt) - do i1 = LB(1), UB(1) - call SeaSt_PackConstrState(RF, InData%z_SeaSt(i1)) - end do - end if - call RegPack(RF, allocated(InData%OtherSt_SeaSt)) - if (allocated(InData%OtherSt_SeaSt)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt_SeaSt), ubound(InData%OtherSt_SeaSt)) - LB(1:1) = lbound(InData%OtherSt_SeaSt) - UB(1:1) = ubound(InData%OtherSt_SeaSt) - do i1 = LB(1), UB(1) - call SeaSt_PackOtherState(RF, InData%OtherSt_SeaSt(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_SeaSt)) - if (allocated(InData%u_SeaSt)) then - call RegPackBounds(RF, 1, lbound(InData%u_SeaSt), ubound(InData%u_SeaSt)) - LB(1:1) = lbound(InData%u_SeaSt) - UB(1:1) = ubound(InData%u_SeaSt) - do i1 = LB(1), UB(1) - call SeaSt_PackInput(RF, InData%u_SeaSt(i1)) - end do - end if - call RegPack(RF, allocated(InData%x_IceF)) - if (allocated(InData%x_IceF)) then - call RegPackBounds(RF, 1, lbound(InData%x_IceF), ubound(InData%x_IceF)) - LB(1:1) = lbound(InData%x_IceF) - UB(1:1) = ubound(InData%x_IceF) - do i1 = LB(1), UB(1) - call IceFloe_PackContState(RF, InData%x_IceF(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_IceF)) - if (allocated(InData%xd_IceF)) then - call RegPackBounds(RF, 1, lbound(InData%xd_IceF), ubound(InData%xd_IceF)) - LB(1:1) = lbound(InData%xd_IceF) - UB(1:1) = ubound(InData%xd_IceF) - do i1 = LB(1), UB(1) - call IceFloe_PackDiscState(RF, InData%xd_IceF(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_IceF)) - if (allocated(InData%z_IceF)) then - call RegPackBounds(RF, 1, lbound(InData%z_IceF), ubound(InData%z_IceF)) - LB(1:1) = lbound(InData%z_IceF) - UB(1:1) = ubound(InData%z_IceF) - do i1 = LB(1), UB(1) - call IceFloe_PackConstrState(RF, InData%z_IceF(i1)) - end do - end if - call RegPack(RF, allocated(InData%OtherSt_IceF)) - if (allocated(InData%OtherSt_IceF)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt_IceF), ubound(InData%OtherSt_IceF)) - LB(1:1) = lbound(InData%OtherSt_IceF) - UB(1:1) = ubound(InData%OtherSt_IceF) - do i1 = LB(1), UB(1) - call IceFloe_PackOtherState(RF, InData%OtherSt_IceF(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_IceF)) - if (allocated(InData%u_IceF)) then - call RegPackBounds(RF, 1, lbound(InData%u_IceF), ubound(InData%u_IceF)) - LB(1:1) = lbound(InData%u_IceF) - UB(1:1) = ubound(InData%u_IceF) - do i1 = LB(1), UB(1) - call IceFloe_PackInput(RF, InData%u_IceF(i1)) - end do - end if - call RegPack(RF, allocated(InData%x_MAP)) - if (allocated(InData%x_MAP)) then - call RegPackBounds(RF, 1, lbound(InData%x_MAP), ubound(InData%x_MAP)) - LB(1:1) = lbound(InData%x_MAP) - UB(1:1) = ubound(InData%x_MAP) - do i1 = LB(1), UB(1) - call MAP_PackContState(RF, InData%x_MAP(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_MAP)) - if (allocated(InData%xd_MAP)) then - call RegPackBounds(RF, 1, lbound(InData%xd_MAP), ubound(InData%xd_MAP)) - LB(1:1) = lbound(InData%xd_MAP) - UB(1:1) = ubound(InData%xd_MAP) - do i1 = LB(1), UB(1) - call MAP_PackDiscState(RF, InData%xd_MAP(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_MAP)) - if (allocated(InData%z_MAP)) then - call RegPackBounds(RF, 1, lbound(InData%z_MAP), ubound(InData%z_MAP)) - LB(1:1) = lbound(InData%z_MAP) - UB(1:1) = ubound(InData%z_MAP) - do i1 = LB(1), UB(1) - call MAP_PackConstrState(RF, InData%z_MAP(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_MAP)) - if (allocated(InData%u_MAP)) then - call RegPackBounds(RF, 1, lbound(InData%u_MAP), ubound(InData%u_MAP)) - LB(1:1) = lbound(InData%u_MAP) - UB(1:1) = ubound(InData%u_MAP) - do i1 = LB(1), UB(1) - call MAP_PackInput(RF, InData%u_MAP(i1)) - end do - end if - call RegPack(RF, allocated(InData%x_FEAM)) - if (allocated(InData%x_FEAM)) then - call RegPackBounds(RF, 1, lbound(InData%x_FEAM), ubound(InData%x_FEAM)) - LB(1:1) = lbound(InData%x_FEAM) - UB(1:1) = ubound(InData%x_FEAM) - do i1 = LB(1), UB(1) - call FEAM_PackContState(RF, InData%x_FEAM(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_FEAM)) - if (allocated(InData%xd_FEAM)) then - call RegPackBounds(RF, 1, lbound(InData%xd_FEAM), ubound(InData%xd_FEAM)) - LB(1:1) = lbound(InData%xd_FEAM) - UB(1:1) = ubound(InData%xd_FEAM) - do i1 = LB(1), UB(1) - call FEAM_PackDiscState(RF, InData%xd_FEAM(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_FEAM)) - if (allocated(InData%z_FEAM)) then - call RegPackBounds(RF, 1, lbound(InData%z_FEAM), ubound(InData%z_FEAM)) - LB(1:1) = lbound(InData%z_FEAM) - UB(1:1) = ubound(InData%z_FEAM) - do i1 = LB(1), UB(1) - call FEAM_PackConstrState(RF, InData%z_FEAM(i1)) - end do - end if - call RegPack(RF, allocated(InData%OtherSt_FEAM)) - if (allocated(InData%OtherSt_FEAM)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt_FEAM), ubound(InData%OtherSt_FEAM)) - LB(1:1) = lbound(InData%OtherSt_FEAM) - UB(1:1) = ubound(InData%OtherSt_FEAM) - do i1 = LB(1), UB(1) - call FEAM_PackOtherState(RF, InData%OtherSt_FEAM(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_FEAM)) - if (allocated(InData%u_FEAM)) then - call RegPackBounds(RF, 1, lbound(InData%u_FEAM), ubound(InData%u_FEAM)) - LB(1:1) = lbound(InData%u_FEAM) - UB(1:1) = ubound(InData%u_FEAM) - do i1 = LB(1), UB(1) - call FEAM_PackInput(RF, InData%u_FEAM(i1)) - end do - end if - call RegPack(RF, allocated(InData%x_MD)) - if (allocated(InData%x_MD)) then - call RegPackBounds(RF, 1, lbound(InData%x_MD), ubound(InData%x_MD)) - LB(1:1) = lbound(InData%x_MD) - UB(1:1) = ubound(InData%x_MD) - do i1 = LB(1), UB(1) - call MD_PackContState(RF, InData%x_MD(i1)) - end do - end if - call RegPack(RF, allocated(InData%xd_MD)) - if (allocated(InData%xd_MD)) then - call RegPackBounds(RF, 1, lbound(InData%xd_MD), ubound(InData%xd_MD)) - LB(1:1) = lbound(InData%xd_MD) - UB(1:1) = ubound(InData%xd_MD) - do i1 = LB(1), UB(1) - call MD_PackDiscState(RF, InData%xd_MD(i1)) - end do - end if - call RegPack(RF, allocated(InData%z_MD)) - if (allocated(InData%z_MD)) then - call RegPackBounds(RF, 1, lbound(InData%z_MD), ubound(InData%z_MD)) - LB(1:1) = lbound(InData%z_MD) - UB(1:1) = ubound(InData%z_MD) - do i1 = LB(1), UB(1) - call MD_PackConstrState(RF, InData%z_MD(i1)) - end do - end if - call RegPack(RF, allocated(InData%OtherSt_MD)) - if (allocated(InData%OtherSt_MD)) then - call RegPackBounds(RF, 1, lbound(InData%OtherSt_MD), ubound(InData%OtherSt_MD)) - LB(1:1) = lbound(InData%OtherSt_MD) - UB(1:1) = ubound(InData%OtherSt_MD) - do i1 = LB(1), UB(1) - call MD_PackOtherState(RF, InData%OtherSt_MD(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_MD)) - if (allocated(InData%u_MD)) then - call RegPackBounds(RF, 1, lbound(InData%u_MD), ubound(InData%u_MD)) - LB(1:1) = lbound(InData%u_MD) - UB(1:1) = ubound(InData%u_MD) - do i1 = LB(1), UB(1) - call MD_PackInput(RF, InData%u_MD(i1)) - end do - end if - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_UnPackLinStateSave(RF, OutData) - type(RegFile), intent(inout) :: RF - type(FAST_LinStateSave), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackLinStateSave' - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - if (allocated(OutData%x_IceD)) deallocate(OutData%x_IceD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_UnpackContState(RF, OutData%x_IceD(i1,i2)) ! x_IceD - end do - end do - end if - if (allocated(OutData%xd_IceD)) deallocate(OutData%xd_IceD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_UnpackDiscState(RF, OutData%xd_IceD(i1,i2)) ! xd_IceD - end do - end do - end if - if (allocated(OutData%z_IceD)) deallocate(OutData%z_IceD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_UnpackConstrState(RF, OutData%z_IceD(i1,i2)) ! z_IceD - end do - end do - end if - if (allocated(OutData%OtherSt_IceD)) deallocate(OutData%OtherSt_IceD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_UnpackOtherState(RF, OutData%OtherSt_IceD(i1,i2)) ! OtherSt_IceD - end do - end do - end if - if (allocated(OutData%u_IceD)) deallocate(OutData%u_IceD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_UnpackInput(RF, OutData%u_IceD(i1,i2)) ! u_IceD - end do - end do - end if - if (allocated(OutData%x_BD)) deallocate(OutData%x_BD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_BD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_UnpackContState(RF, OutData%x_BD(i1,i2)) ! x_BD - end do - end do - end if - if (allocated(OutData%xd_BD)) deallocate(OutData%xd_BD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_BD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_UnpackDiscState(RF, OutData%xd_BD(i1,i2)) ! xd_BD - end do - end do - end if - if (allocated(OutData%z_BD)) deallocate(OutData%z_BD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_BD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_UnpackConstrState(RF, OutData%z_BD(i1,i2)) ! z_BD - end do - end do - end if - if (allocated(OutData%OtherSt_BD)) deallocate(OutData%OtherSt_BD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_BD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_UnpackOtherState(RF, OutData%OtherSt_BD(i1,i2)) ! OtherSt_BD - end do - end do - end if - if (allocated(OutData%u_BD)) deallocate(OutData%u_BD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_UnpackInput(RF, OutData%u_BD(i1,i2)) ! u_BD - end do - end do - end if - if (allocated(OutData%x_ED)) deallocate(OutData%x_ED) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_ED(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ED.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ED_UnpackContState(RF, OutData%x_ED(i1)) ! x_ED - end do - end if - if (allocated(OutData%xd_ED)) deallocate(OutData%xd_ED) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_ED(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ED.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ED_UnpackDiscState(RF, OutData%xd_ED(i1)) ! xd_ED - end do - end if - if (allocated(OutData%z_ED)) deallocate(OutData%z_ED) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_ED(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ED.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ED_UnpackConstrState(RF, OutData%z_ED(i1)) ! z_ED - end do - end if - if (allocated(OutData%OtherSt_ED)) deallocate(OutData%OtherSt_ED) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_ED(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ED.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ED_UnpackOtherState(RF, OutData%OtherSt_ED(i1)) ! OtherSt_ED - end do - end if - if (allocated(OutData%u_ED)) deallocate(OutData%u_ED) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_ED(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ED.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ED_UnpackInput(RF, OutData%u_ED(i1)) ! u_ED - end do - end if - if (allocated(OutData%x_SrvD)) deallocate(OutData%x_SrvD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_SrvD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SrvD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SrvD_UnpackContState(RF, OutData%x_SrvD(i1)) ! x_SrvD - end do - end if - if (allocated(OutData%xd_SrvD)) deallocate(OutData%xd_SrvD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_SrvD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SrvD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SrvD_UnpackDiscState(RF, OutData%xd_SrvD(i1)) ! xd_SrvD - end do - end if - if (allocated(OutData%z_SrvD)) deallocate(OutData%z_SrvD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_SrvD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SrvD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SrvD_UnpackConstrState(RF, OutData%z_SrvD(i1)) ! z_SrvD - end do - end if - if (allocated(OutData%OtherSt_SrvD)) deallocate(OutData%OtherSt_SrvD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_SrvD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SrvD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SrvD_UnpackOtherState(RF, OutData%OtherSt_SrvD(i1)) ! OtherSt_SrvD - end do - end if - if (allocated(OutData%u_SrvD)) deallocate(OutData%u_SrvD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_SrvD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SrvD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SrvD_UnpackInput(RF, OutData%u_SrvD(i1)) ! u_SrvD - end do - end if - if (allocated(OutData%x_AD)) deallocate(OutData%x_AD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_AD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_AD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call AD_UnpackContState(RF, OutData%x_AD(i1)) ! x_AD - end do - end if - if (allocated(OutData%xd_AD)) deallocate(OutData%xd_AD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_AD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_AD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call AD_UnpackDiscState(RF, OutData%xd_AD(i1)) ! xd_AD - end do - end if - if (allocated(OutData%z_AD)) deallocate(OutData%z_AD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_AD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_AD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call AD_UnpackConstrState(RF, OutData%z_AD(i1)) ! z_AD - end do - end if - if (allocated(OutData%OtherSt_AD)) deallocate(OutData%OtherSt_AD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_AD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_AD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call AD_UnpackOtherState(RF, OutData%OtherSt_AD(i1)) ! OtherSt_AD - end do - end if - if (allocated(OutData%u_AD)) deallocate(OutData%u_AD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_AD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_AD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call AD_UnpackInput(RF, OutData%u_AD(i1)) ! u_AD - end do - end if - if (allocated(OutData%x_IfW)) deallocate(OutData%x_IfW) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_IfW(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call InflowWind_UnpackContState(RF, OutData%x_IfW(i1)) ! x_IfW - end do - end if - if (allocated(OutData%xd_IfW)) deallocate(OutData%xd_IfW) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_IfW(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call InflowWind_UnpackDiscState(RF, OutData%xd_IfW(i1)) ! xd_IfW - end do - end if - if (allocated(OutData%z_IfW)) deallocate(OutData%z_IfW) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_IfW(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call InflowWind_UnpackConstrState(RF, OutData%z_IfW(i1)) ! z_IfW - end do - end if - if (allocated(OutData%OtherSt_IfW)) deallocate(OutData%OtherSt_IfW) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_IfW(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call InflowWind_UnpackOtherState(RF, OutData%OtherSt_IfW(i1)) ! OtherSt_IfW - end do - end if - if (allocated(OutData%u_IfW)) deallocate(OutData%u_IfW) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_IfW(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call InflowWind_UnpackInput(RF, OutData%u_IfW(i1)) ! u_IfW - end do - end if - if (allocated(OutData%x_SD)) deallocate(OutData%x_SD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_SD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SD_UnpackContState(RF, OutData%x_SD(i1)) ! x_SD - end do - end if - if (allocated(OutData%xd_SD)) deallocate(OutData%xd_SD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_SD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SD_UnpackDiscState(RF, OutData%xd_SD(i1)) ! xd_SD - end do - end if - if (allocated(OutData%z_SD)) deallocate(OutData%z_SD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_SD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SD_UnpackConstrState(RF, OutData%z_SD(i1)) ! z_SD - end do - end if - if (allocated(OutData%OtherSt_SD)) deallocate(OutData%OtherSt_SD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_SD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SD_UnpackOtherState(RF, OutData%OtherSt_SD(i1)) ! OtherSt_SD - end do - end if - if (allocated(OutData%u_SD)) deallocate(OutData%u_SD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_SD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SD_UnpackInput(RF, OutData%u_SD(i1)) ! u_SD - end do - end if - if (allocated(OutData%x_ExtPtfm)) deallocate(OutData%x_ExtPtfm) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_ExtPtfm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ExtPtfm.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ExtPtfm_UnpackContState(RF, OutData%x_ExtPtfm(i1)) ! x_ExtPtfm - end do - end if - if (allocated(OutData%xd_ExtPtfm)) deallocate(OutData%xd_ExtPtfm) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_ExtPtfm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ExtPtfm.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ExtPtfm_UnpackDiscState(RF, OutData%xd_ExtPtfm(i1)) ! xd_ExtPtfm - end do - end if - if (allocated(OutData%z_ExtPtfm)) deallocate(OutData%z_ExtPtfm) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_ExtPtfm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ExtPtfm.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ExtPtfm_UnpackConstrState(RF, OutData%z_ExtPtfm(i1)) ! z_ExtPtfm - end do - end if - if (allocated(OutData%OtherSt_ExtPtfm)) deallocate(OutData%OtherSt_ExtPtfm) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_ExtPtfm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ExtPtfm.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ExtPtfm_UnpackOtherState(RF, OutData%OtherSt_ExtPtfm(i1)) ! OtherSt_ExtPtfm - end do - end if - if (allocated(OutData%u_ExtPtfm)) deallocate(OutData%u_ExtPtfm) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_ExtPtfm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ExtPtfm.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ExtPtfm_UnpackInput(RF, OutData%u_ExtPtfm(i1)) ! u_ExtPtfm - end do - end if - if (allocated(OutData%x_HD)) deallocate(OutData%x_HD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_HD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_HD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call HydroDyn_UnpackContState(RF, OutData%x_HD(i1)) ! x_HD - end do - end if - if (allocated(OutData%xd_HD)) deallocate(OutData%xd_HD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_HD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_HD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call HydroDyn_UnpackDiscState(RF, OutData%xd_HD(i1)) ! xd_HD - end do - end if - if (allocated(OutData%z_HD)) deallocate(OutData%z_HD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_HD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_HD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call HydroDyn_UnpackConstrState(RF, OutData%z_HD(i1)) ! z_HD - end do - end if - if (allocated(OutData%OtherSt_HD)) deallocate(OutData%OtherSt_HD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_HD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_HD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call HydroDyn_UnpackOtherState(RF, OutData%OtherSt_HD(i1)) ! OtherSt_HD - end do - end if - if (allocated(OutData%u_HD)) deallocate(OutData%u_HD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_HD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_HD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call HydroDyn_UnpackInput(RF, OutData%u_HD(i1)) ! u_HD - end do - end if - if (allocated(OutData%x_SeaSt)) deallocate(OutData%x_SeaSt) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_SeaSt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SeaSt.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SeaSt_UnpackContState(RF, OutData%x_SeaSt(i1)) ! x_SeaSt - end do - end if - if (allocated(OutData%xd_SeaSt)) deallocate(OutData%xd_SeaSt) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_SeaSt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SeaSt.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SeaSt_UnpackDiscState(RF, OutData%xd_SeaSt(i1)) ! xd_SeaSt - end do - end if - if (allocated(OutData%z_SeaSt)) deallocate(OutData%z_SeaSt) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_SeaSt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SeaSt.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SeaSt_UnpackConstrState(RF, OutData%z_SeaSt(i1)) ! z_SeaSt - end do - end if - if (allocated(OutData%OtherSt_SeaSt)) deallocate(OutData%OtherSt_SeaSt) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_SeaSt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SeaSt.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SeaSt_UnpackOtherState(RF, OutData%OtherSt_SeaSt(i1)) ! OtherSt_SeaSt - end do - end if - if (allocated(OutData%u_SeaSt)) deallocate(OutData%u_SeaSt) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_SeaSt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SeaSt.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SeaSt_UnpackInput(RF, OutData%u_SeaSt(i1)) ! u_SeaSt - end do - end if - if (allocated(OutData%x_IceF)) deallocate(OutData%x_IceF) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_IceF(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceF.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call IceFloe_UnpackContState(RF, OutData%x_IceF(i1)) ! x_IceF - end do - end if - if (allocated(OutData%xd_IceF)) deallocate(OutData%xd_IceF) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_IceF(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceF.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call IceFloe_UnpackDiscState(RF, OutData%xd_IceF(i1)) ! xd_IceF - end do - end if - if (allocated(OutData%z_IceF)) deallocate(OutData%z_IceF) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_IceF(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceF.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call IceFloe_UnpackConstrState(RF, OutData%z_IceF(i1)) ! z_IceF - end do - end if - if (allocated(OutData%OtherSt_IceF)) deallocate(OutData%OtherSt_IceF) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_IceF(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceF.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call IceFloe_UnpackOtherState(RF, OutData%OtherSt_IceF(i1)) ! OtherSt_IceF - end do - end if - if (allocated(OutData%u_IceF)) deallocate(OutData%u_IceF) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_IceF(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceF.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call IceFloe_UnpackInput(RF, OutData%u_IceF(i1)) ! u_IceF - end do - end if - if (allocated(OutData%x_MAP)) deallocate(OutData%x_MAP) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_MAP(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MAP.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MAP_UnpackContState(RF, OutData%x_MAP(i1)) ! x_MAP - end do - end if - if (allocated(OutData%xd_MAP)) deallocate(OutData%xd_MAP) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_MAP(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MAP.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MAP_UnpackDiscState(RF, OutData%xd_MAP(i1)) ! xd_MAP - end do - end if - if (allocated(OutData%z_MAP)) deallocate(OutData%z_MAP) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_MAP(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MAP.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MAP_UnpackConstrState(RF, OutData%z_MAP(i1)) ! z_MAP - end do - end if - if (allocated(OutData%u_MAP)) deallocate(OutData%u_MAP) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_MAP(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MAP.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MAP_UnpackInput(RF, OutData%u_MAP(i1)) ! u_MAP - end do - end if - if (allocated(OutData%x_FEAM)) deallocate(OutData%x_FEAM) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_FEAM(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_FEAM.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call FEAM_UnpackContState(RF, OutData%x_FEAM(i1)) ! x_FEAM - end do - end if - if (allocated(OutData%xd_FEAM)) deallocate(OutData%xd_FEAM) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_FEAM(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_FEAM.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call FEAM_UnpackDiscState(RF, OutData%xd_FEAM(i1)) ! xd_FEAM - end do - end if - if (allocated(OutData%z_FEAM)) deallocate(OutData%z_FEAM) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_FEAM(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_FEAM.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call FEAM_UnpackConstrState(RF, OutData%z_FEAM(i1)) ! z_FEAM - end do - end if - if (allocated(OutData%OtherSt_FEAM)) deallocate(OutData%OtherSt_FEAM) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_FEAM(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_FEAM.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call FEAM_UnpackOtherState(RF, OutData%OtherSt_FEAM(i1)) ! OtherSt_FEAM - end do - end if - if (allocated(OutData%u_FEAM)) deallocate(OutData%u_FEAM) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_FEAM(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_FEAM.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call FEAM_UnpackInput(RF, OutData%u_FEAM(i1)) ! u_FEAM - end do - end if - if (allocated(OutData%x_MD)) deallocate(OutData%x_MD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%x_MD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MD_UnpackContState(RF, OutData%x_MD(i1)) ! x_MD - end do - end if - if (allocated(OutData%xd_MD)) deallocate(OutData%xd_MD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%xd_MD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MD_UnpackDiscState(RF, OutData%xd_MD(i1)) ! xd_MD - end do - end if - if (allocated(OutData%z_MD)) deallocate(OutData%z_MD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%z_MD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MD_UnpackConstrState(RF, OutData%z_MD(i1)) ! z_MD - end do - end if - if (allocated(OutData%OtherSt_MD)) deallocate(OutData%OtherSt_MD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OtherSt_MD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_MD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MD_UnpackOtherState(RF, OutData%OtherSt_MD(i1)) ! OtherSt_MD - end do - end if - if (allocated(OutData%u_MD)) deallocate(OutData%u_MD) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_MD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MD.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MD_UnpackInput(RF, OutData%u_MD(i1)) ! u_MD - end do - end if -end subroutine - -subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, ErrMsg) - type(FAST_LinType), intent(in) :: SrcLinTypeData - type(FAST_LinType), intent(inout) :: DstLinTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'FAST_CopyLinType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcLinTypeData%Names_u)) then - LB(1:1) = lbound(SrcLinTypeData%Names_u) - UB(1:1) = ubound(SrcLinTypeData%Names_u) - if (.not. allocated(DstLinTypeData%Names_u)) then - allocate(DstLinTypeData%Names_u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%Names_u = SrcLinTypeData%Names_u - end if - if (allocated(SrcLinTypeData%Names_y)) then - LB(1:1) = lbound(SrcLinTypeData%Names_y) - UB(1:1) = ubound(SrcLinTypeData%Names_y) - if (.not. allocated(DstLinTypeData%Names_y)) then - allocate(DstLinTypeData%Names_y(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%Names_y = SrcLinTypeData%Names_y - end if - if (allocated(SrcLinTypeData%Names_x)) then - LB(1:1) = lbound(SrcLinTypeData%Names_x) - UB(1:1) = ubound(SrcLinTypeData%Names_x) - if (.not. allocated(DstLinTypeData%Names_x)) then - allocate(DstLinTypeData%Names_x(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_x.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%Names_x = SrcLinTypeData%Names_x - end if - if (allocated(SrcLinTypeData%Names_xd)) then - LB(1:1) = lbound(SrcLinTypeData%Names_xd) - UB(1:1) = ubound(SrcLinTypeData%Names_xd) - if (.not. allocated(DstLinTypeData%Names_xd)) then - allocate(DstLinTypeData%Names_xd(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_xd.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%Names_xd = SrcLinTypeData%Names_xd - end if - if (allocated(SrcLinTypeData%Names_z)) then - LB(1:1) = lbound(SrcLinTypeData%Names_z) - UB(1:1) = ubound(SrcLinTypeData%Names_z) - if (.not. allocated(DstLinTypeData%Names_z)) then - allocate(DstLinTypeData%Names_z(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_z.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%Names_z = SrcLinTypeData%Names_z - end if - if (allocated(SrcLinTypeData%op_u)) then - LB(1:1) = lbound(SrcLinTypeData%op_u) - UB(1:1) = ubound(SrcLinTypeData%op_u) - if (.not. allocated(DstLinTypeData%op_u)) then - allocate(DstLinTypeData%op_u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%op_u = SrcLinTypeData%op_u - end if - if (allocated(SrcLinTypeData%op_y)) then - LB(1:1) = lbound(SrcLinTypeData%op_y) - UB(1:1) = ubound(SrcLinTypeData%op_y) - if (.not. allocated(DstLinTypeData%op_y)) then - allocate(DstLinTypeData%op_y(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%op_y = SrcLinTypeData%op_y - end if - if (allocated(SrcLinTypeData%op_x)) then - LB(1:1) = lbound(SrcLinTypeData%op_x) - UB(1:1) = ubound(SrcLinTypeData%op_x) - if (.not. allocated(DstLinTypeData%op_x)) then - allocate(DstLinTypeData%op_x(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%op_x = SrcLinTypeData%op_x - end if - if (allocated(SrcLinTypeData%op_dx)) then - LB(1:1) = lbound(SrcLinTypeData%op_dx) - UB(1:1) = ubound(SrcLinTypeData%op_dx) - if (.not. allocated(DstLinTypeData%op_dx)) then - allocate(DstLinTypeData%op_dx(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_dx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%op_dx = SrcLinTypeData%op_dx - end if - if (allocated(SrcLinTypeData%op_xd)) then - LB(1:1) = lbound(SrcLinTypeData%op_xd) - UB(1:1) = ubound(SrcLinTypeData%op_xd) - if (.not. allocated(DstLinTypeData%op_xd)) then - allocate(DstLinTypeData%op_xd(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_xd.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%op_xd = SrcLinTypeData%op_xd - end if - if (allocated(SrcLinTypeData%op_z)) then - LB(1:1) = lbound(SrcLinTypeData%op_z) - UB(1:1) = ubound(SrcLinTypeData%op_z) - if (.not. allocated(DstLinTypeData%op_z)) then - allocate(DstLinTypeData%op_z(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_z.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%op_z = SrcLinTypeData%op_z - end if - if (allocated(SrcLinTypeData%op_x_eig_mag)) then - LB(1:1) = lbound(SrcLinTypeData%op_x_eig_mag) - UB(1:1) = ubound(SrcLinTypeData%op_x_eig_mag) - if (.not. allocated(DstLinTypeData%op_x_eig_mag)) then - allocate(DstLinTypeData%op_x_eig_mag(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_mag.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%op_x_eig_mag = SrcLinTypeData%op_x_eig_mag - end if - if (allocated(SrcLinTypeData%op_x_eig_phase)) then - LB(1:1) = lbound(SrcLinTypeData%op_x_eig_phase) - UB(1:1) = ubound(SrcLinTypeData%op_x_eig_phase) - if (.not. allocated(DstLinTypeData%op_x_eig_phase)) then - allocate(DstLinTypeData%op_x_eig_phase(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_phase.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%op_x_eig_phase = SrcLinTypeData%op_x_eig_phase - end if - if (allocated(SrcLinTypeData%Use_u)) then - LB(1:1) = lbound(SrcLinTypeData%Use_u) - UB(1:1) = ubound(SrcLinTypeData%Use_u) - if (.not. allocated(DstLinTypeData%Use_u)) then - allocate(DstLinTypeData%Use_u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%Use_u = SrcLinTypeData%Use_u - end if - if (allocated(SrcLinTypeData%Use_y)) then - LB(1:1) = lbound(SrcLinTypeData%Use_y) - UB(1:1) = ubound(SrcLinTypeData%Use_y) - if (.not. allocated(DstLinTypeData%Use_y)) then - allocate(DstLinTypeData%Use_y(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%Use_y = SrcLinTypeData%Use_y - end if - if (allocated(SrcLinTypeData%A)) then - LB(1:2) = lbound(SrcLinTypeData%A) - UB(1:2) = ubound(SrcLinTypeData%A) - if (.not. allocated(DstLinTypeData%A)) then - allocate(DstLinTypeData%A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%A.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%A = SrcLinTypeData%A - end if - if (allocated(SrcLinTypeData%B)) then - LB(1:2) = lbound(SrcLinTypeData%B) - UB(1:2) = ubound(SrcLinTypeData%B) - if (.not. allocated(DstLinTypeData%B)) then - allocate(DstLinTypeData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%B.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%B = SrcLinTypeData%B - end if - if (allocated(SrcLinTypeData%C)) then - LB(1:2) = lbound(SrcLinTypeData%C) - UB(1:2) = ubound(SrcLinTypeData%C) - if (.not. allocated(DstLinTypeData%C)) then - allocate(DstLinTypeData%C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%C.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%C = SrcLinTypeData%C - end if - if (allocated(SrcLinTypeData%D)) then - LB(1:2) = lbound(SrcLinTypeData%D) - UB(1:2) = ubound(SrcLinTypeData%D) - if (.not. allocated(DstLinTypeData%D)) then - allocate(DstLinTypeData%D(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%D.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%D = SrcLinTypeData%D - end if - if (allocated(SrcLinTypeData%StateRotation)) then - LB(1:2) = lbound(SrcLinTypeData%StateRotation) - UB(1:2) = ubound(SrcLinTypeData%StateRotation) - if (.not. allocated(DstLinTypeData%StateRotation)) then - allocate(DstLinTypeData%StateRotation(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRotation.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%StateRotation = SrcLinTypeData%StateRotation - end if - if (allocated(SrcLinTypeData%StateRel_x)) then - LB(1:2) = lbound(SrcLinTypeData%StateRel_x) - UB(1:2) = ubound(SrcLinTypeData%StateRel_x) - if (.not. allocated(DstLinTypeData%StateRel_x)) then - allocate(DstLinTypeData%StateRel_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_x.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%StateRel_x = SrcLinTypeData%StateRel_x - end if - if (allocated(SrcLinTypeData%StateRel_xdot)) then - LB(1:2) = lbound(SrcLinTypeData%StateRel_xdot) - UB(1:2) = ubound(SrcLinTypeData%StateRel_xdot) - if (.not. allocated(DstLinTypeData%StateRel_xdot)) then - allocate(DstLinTypeData%StateRel_xdot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_xdot.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%StateRel_xdot = SrcLinTypeData%StateRel_xdot - end if - if (allocated(SrcLinTypeData%IsLoad_u)) then - LB(1:1) = lbound(SrcLinTypeData%IsLoad_u) - UB(1:1) = ubound(SrcLinTypeData%IsLoad_u) - if (.not. allocated(DstLinTypeData%IsLoad_u)) then - allocate(DstLinTypeData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) return end if end if @@ -5593,12 +2068,6 @@ subroutine FAST_DestroyLinType(LinTypeData, ErrStat, ErrMsg) if (allocated(LinTypeData%StateRotation)) then deallocate(LinTypeData%StateRotation) end if - if (allocated(LinTypeData%StateRel_x)) then - deallocate(LinTypeData%StateRel_x) - end if - if (allocated(LinTypeData%StateRel_xdot)) then - deallocate(LinTypeData%StateRel_xdot) - end if if (allocated(LinTypeData%IsLoad_u)) then deallocate(LinTypeData%IsLoad_u) end if @@ -5644,8 +2113,6 @@ subroutine FAST_PackLinType(RF, Indata) call RegPackAlloc(RF, InData%C) call RegPackAlloc(RF, InData%D) call RegPackAlloc(RF, InData%StateRotation) - call RegPackAlloc(RF, InData%StateRel_x) - call RegPackAlloc(RF, InData%StateRel_xdot) call RegPackAlloc(RF, InData%IsLoad_u) call RegPackAlloc(RF, InData%RotFrame_u) call RegPackAlloc(RF, InData%RotFrame_y) @@ -5686,8 +2153,6 @@ subroutine FAST_UnPackLinType(RF, OutData) call RegUnpackAlloc(RF, OutData%C); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%D); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%StateRotation); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%StateRel_x); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%StateRel_xdot); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return @@ -6045,7 +2510,7 @@ subroutine FAST_UnPackMiscLinType(RF, OutData) end subroutine subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, CtrlCode, ErrStat, ErrMsg) - type(FAST_OutputFileType), intent(inout) :: SrcOutputFileTypeData + type(FAST_OutputFileType), intent(in) :: SrcOutputFileTypeData type(FAST_OutputFileType), intent(inout) :: DstOutputFileTypeData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat @@ -6127,9 +2592,6 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstOutputFileTypeData%ActualChanLen = SrcOutputFileTypeData%ActualChanLen - call FAST_CopyLinStateSave(SrcOutputFileTypeData%op, DstOutputFileTypeData%op, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return DstOutputFileTypeData%DriverWriteOutput = SrcOutputFileTypeData%DriverWriteOutput end subroutine @@ -6164,8 +2626,6 @@ subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) end do call FAST_DestroyLinFileType(OutputFileTypeData%Lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call FAST_DestroyLinStateSave(OutputFileTypeData%op, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FAST_PackOutputFileType(RF, Indata) @@ -6197,7 +2657,6 @@ subroutine FAST_PackOutputFileType(RF, Indata) call RegPack(RF, InData%VTK_LastWaveIndx) call FAST_PackLinFileType(RF, InData%Lin) call RegPack(RF, InData%ActualChanLen) - call FAST_PackLinStateSave(RF, InData%op) call RegPack(RF, InData%DriverWriteOutput) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -6233,7 +2692,6 @@ subroutine FAST_UnPackOutputFileType(RF, OutData) call RegUnpack(RF, OutData%VTK_LastWaveIndx); if (RegCheckErr(RF, RoutineName)) return call FAST_UnpackLinFileType(RF, OutData%Lin) ! Lin call RegUnpack(RF, OutData%ActualChanLen); if (RegCheckErr(RF, RoutineName)) return - call FAST_UnpackLinStateSave(RF, OutData%op) ! op call RegUnpack(RF, OutData%DriverWriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -6338,22 +2796,6 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcIceDyn_DataData%u)) then - LB(1:1) = lbound(SrcIceDyn_DataData%u) - UB(1:1) = ubound(SrcIceDyn_DataData%u) - if (.not. allocated(DstIceDyn_DataData%u)) then - allocate(DstIceDyn_DataData%u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call IceD_CopyInput(SrcIceDyn_DataData%u(i1), DstIceDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcIceDyn_DataData%y)) then LB(1:1) = lbound(SrcIceDyn_DataData%y) UB(1:1) = ubound(SrcIceDyn_DataData%y) @@ -6404,24 +2846,6 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end do end if - if (allocated(SrcIceDyn_DataData%Input_Saved)) then - LB(1:2) = lbound(SrcIceDyn_DataData%Input_Saved) - UB(1:2) = ubound(SrcIceDyn_DataData%Input_Saved) - if (.not. allocated(DstIceDyn_DataData%Input_Saved)) then - allocate(DstIceDyn_DataData%Input_Saved(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_CopyInput(SrcIceDyn_DataData%Input_Saved(i1,i2), DstIceDyn_DataData%Input_Saved(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do - end if if (allocated(SrcIceDyn_DataData%InputTimes)) then LB(1:2) = lbound(SrcIceDyn_DataData%InputTimes) UB(1:2) = ubound(SrcIceDyn_DataData%InputTimes) @@ -6434,18 +2858,6 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end if DstIceDyn_DataData%InputTimes = SrcIceDyn_DataData%InputTimes end if - if (allocated(SrcIceDyn_DataData%InputTimes_Saved)) then - LB(1:2) = lbound(SrcIceDyn_DataData%InputTimes_Saved) - UB(1:2) = ubound(SrcIceDyn_DataData%InputTimes_Saved) - if (.not. allocated(DstIceDyn_DataData%InputTimes_Saved)) then - allocate(DstIceDyn_DataData%InputTimes_Saved(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstIceDyn_DataData%InputTimes_Saved = SrcIceDyn_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) @@ -6512,15 +2924,6 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) end do deallocate(IceDyn_DataData%p) end if - if (allocated(IceDyn_DataData%u)) then - LB(1:1) = lbound(IceDyn_DataData%u) - UB(1:1) = ubound(IceDyn_DataData%u) - do i1 = LB(1), UB(1) - call IceD_DestroyInput(IceDyn_DataData%u(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(IceDyn_DataData%u) - end if if (allocated(IceDyn_DataData%y)) then LB(1:1) = lbound(IceDyn_DataData%y) UB(1:1) = ubound(IceDyn_DataData%y) @@ -6550,23 +2953,9 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) end do deallocate(IceDyn_DataData%Input) end if - if (allocated(IceDyn_DataData%Input_Saved)) then - LB(1:2) = lbound(IceDyn_DataData%Input_Saved) - UB(1:2) = ubound(IceDyn_DataData%Input_Saved) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_DestroyInput(IceDyn_DataData%Input_Saved(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(IceDyn_DataData%Input_Saved) - end if if (allocated(IceDyn_DataData%InputTimes)) then deallocate(IceDyn_DataData%InputTimes) end if - if (allocated(IceDyn_DataData%InputTimes_Saved)) then - deallocate(IceDyn_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackIceDyn_Data(RF, Indata) @@ -6629,15 +3018,6 @@ subroutine FAST_PackIceDyn_Data(RF, Indata) call IceD_PackParam(RF, InData%p(i1)) end do end if - call RegPack(RF, allocated(InData%u)) - if (allocated(InData%u)) then - call RegPackBounds(RF, 1, lbound(InData%u), ubound(InData%u)) - LB(1:1) = lbound(InData%u) - UB(1:1) = ubound(InData%u) - do i1 = LB(1), UB(1) - call IceD_PackInput(RF, InData%u(i1)) - end do - end if call RegPack(RF, allocated(InData%y)) if (allocated(InData%y)) then call RegPackBounds(RF, 1, lbound(InData%y), ubound(InData%y)) @@ -6667,19 +3047,7 @@ subroutine FAST_PackIceDyn_Data(RF, Indata) end do end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 2, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) - LB(1:2) = lbound(InData%Input_Saved) - UB(1:2) = ubound(InData%Input_Saved) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_PackInput(RF, InData%Input_Saved(i1,i2)) - end do - end do - end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -6765,19 +3133,6 @@ subroutine FAST_UnPackIceDyn_Data(RF, OutData) call IceD_UnpackParam(RF, OutData%p(i1)) ! p end do end if - if (allocated(OutData%u)) deallocate(OutData%u) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call IceD_UnpackInput(RF, OutData%u(i1)) ! u - end do - end if if (allocated(OutData%y)) deallocate(OutData%y) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -6819,23 +3174,7 @@ subroutine FAST_UnPackIceDyn_Data(RF, OutData) end do end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_UnpackInput(RF, OutData%Input_Saved(i1,i2)) ! Input_Saved - end do - end do - end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlCode, ErrStat, ErrMsg) @@ -6939,22 +3278,6 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcBeamDyn_DataData%u)) then - LB(1:1) = lbound(SrcBeamDyn_DataData%u) - UB(1:1) = ubound(SrcBeamDyn_DataData%u) - if (.not. allocated(DstBeamDyn_DataData%u)) then - allocate(DstBeamDyn_DataData%u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call BD_CopyInput(SrcBeamDyn_DataData%u(i1), DstBeamDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcBeamDyn_DataData%y)) then LB(1:1) = lbound(SrcBeamDyn_DataData%y) UB(1:1) = ubound(SrcBeamDyn_DataData%y) @@ -6987,40 +3310,6 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcBeamDyn_DataData%Output)) then - LB(1:2) = lbound(SrcBeamDyn_DataData%Output) - UB(1:2) = ubound(SrcBeamDyn_DataData%Output) - if (.not. allocated(DstBeamDyn_DataData%Output)) then - allocate(DstBeamDyn_DataData%Output(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_CopyOutput(SrcBeamDyn_DataData%Output(i1,i2), DstBeamDyn_DataData%Output(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do - end if - if (allocated(SrcBeamDyn_DataData%y_interp)) then - LB(1:1) = lbound(SrcBeamDyn_DataData%y_interp) - UB(1:1) = ubound(SrcBeamDyn_DataData%y_interp) - if (.not. allocated(DstBeamDyn_DataData%y_interp)) then - allocate(DstBeamDyn_DataData%y_interp(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y_interp.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call BD_CopyOutput(SrcBeamDyn_DataData%y_interp(i1), DstBeamDyn_DataData%y_interp(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcBeamDyn_DataData%Input)) then LB(1:2) = lbound(SrcBeamDyn_DataData%Input) UB(1:2) = ubound(SrcBeamDyn_DataData%Input) @@ -7039,24 +3328,6 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end do end if - if (allocated(SrcBeamDyn_DataData%Input_Saved)) then - LB(1:2) = lbound(SrcBeamDyn_DataData%Input_Saved) - UB(1:2) = ubound(SrcBeamDyn_DataData%Input_Saved) - if (.not. allocated(DstBeamDyn_DataData%Input_Saved)) then - allocate(DstBeamDyn_DataData%Input_Saved(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_CopyInput(SrcBeamDyn_DataData%Input_Saved(i1,i2), DstBeamDyn_DataData%Input_Saved(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do - end if if (allocated(SrcBeamDyn_DataData%InputTimes)) then LB(1:2) = lbound(SrcBeamDyn_DataData%InputTimes) UB(1:2) = ubound(SrcBeamDyn_DataData%InputTimes) @@ -7069,18 +3340,6 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end if DstBeamDyn_DataData%InputTimes = SrcBeamDyn_DataData%InputTimes end if - if (allocated(SrcBeamDyn_DataData%InputTimes_Saved)) then - LB(1:2) = lbound(SrcBeamDyn_DataData%InputTimes_Saved) - UB(1:2) = ubound(SrcBeamDyn_DataData%InputTimes_Saved) - if (.not. allocated(DstBeamDyn_DataData%InputTimes_Saved)) then - allocate(DstBeamDyn_DataData%InputTimes_Saved(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstBeamDyn_DataData%InputTimes_Saved = SrcBeamDyn_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) @@ -7147,15 +3406,6 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) end do deallocate(BeamDyn_DataData%p) end if - if (allocated(BeamDyn_DataData%u)) then - LB(1:1) = lbound(BeamDyn_DataData%u) - UB(1:1) = ubound(BeamDyn_DataData%u) - do i1 = LB(1), UB(1) - call BD_DestroyInput(BeamDyn_DataData%u(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(BeamDyn_DataData%u) - end if if (allocated(BeamDyn_DataData%y)) then LB(1:1) = lbound(BeamDyn_DataData%y) UB(1:1) = ubound(BeamDyn_DataData%y) @@ -7174,26 +3424,6 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) end do deallocate(BeamDyn_DataData%m) end if - if (allocated(BeamDyn_DataData%Output)) then - LB(1:2) = lbound(BeamDyn_DataData%Output) - UB(1:2) = ubound(BeamDyn_DataData%Output) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_DestroyOutput(BeamDyn_DataData%Output(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(BeamDyn_DataData%Output) - end if - if (allocated(BeamDyn_DataData%y_interp)) then - LB(1:1) = lbound(BeamDyn_DataData%y_interp) - UB(1:1) = ubound(BeamDyn_DataData%y_interp) - do i1 = LB(1), UB(1) - call BD_DestroyOutput(BeamDyn_DataData%y_interp(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(BeamDyn_DataData%y_interp) - end if if (allocated(BeamDyn_DataData%Input)) then LB(1:2) = lbound(BeamDyn_DataData%Input) UB(1:2) = ubound(BeamDyn_DataData%Input) @@ -7205,23 +3435,9 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) end do deallocate(BeamDyn_DataData%Input) end if - if (allocated(BeamDyn_DataData%Input_Saved)) then - LB(1:2) = lbound(BeamDyn_DataData%Input_Saved) - UB(1:2) = ubound(BeamDyn_DataData%Input_Saved) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_DestroyInput(BeamDyn_DataData%Input_Saved(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(BeamDyn_DataData%Input_Saved) - end if if (allocated(BeamDyn_DataData%InputTimes)) then deallocate(BeamDyn_DataData%InputTimes) end if - if (allocated(BeamDyn_DataData%InputTimes_Saved)) then - deallocate(BeamDyn_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackBeamDyn_Data(RF, Indata) @@ -7284,15 +3500,6 @@ subroutine FAST_PackBeamDyn_Data(RF, Indata) call BD_PackParam(RF, InData%p(i1)) end do end if - call RegPack(RF, allocated(InData%u)) - if (allocated(InData%u)) then - call RegPackBounds(RF, 1, lbound(InData%u), ubound(InData%u)) - LB(1:1) = lbound(InData%u) - UB(1:1) = ubound(InData%u) - do i1 = LB(1), UB(1) - call BD_PackInput(RF, InData%u(i1)) - end do - end if call RegPack(RF, allocated(InData%y)) if (allocated(InData%y)) then call RegPackBounds(RF, 1, lbound(InData%y), ubound(InData%y)) @@ -7311,26 +3518,6 @@ subroutine FAST_PackBeamDyn_Data(RF, Indata) call BD_PackMisc(RF, InData%m(i1)) end do end if - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 2, lbound(InData%Output), ubound(InData%Output)) - LB(1:2) = lbound(InData%Output) - UB(1:2) = ubound(InData%Output) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_PackOutput(RF, InData%Output(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%y_interp)) - if (allocated(InData%y_interp)) then - call RegPackBounds(RF, 1, lbound(InData%y_interp), ubound(InData%y_interp)) - LB(1:1) = lbound(InData%y_interp) - UB(1:1) = ubound(InData%y_interp) - do i1 = LB(1), UB(1) - call BD_PackOutput(RF, InData%y_interp(i1)) - end do - end if call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(RF, 2, lbound(InData%Input), ubound(InData%Input)) @@ -7342,19 +3529,7 @@ subroutine FAST_PackBeamDyn_Data(RF, Indata) end do end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 2, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) - LB(1:2) = lbound(InData%Input_Saved) - UB(1:2) = ubound(InData%Input_Saved) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_PackInput(RF, InData%Input_Saved(i1,i2)) - end do - end do - end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -7440,19 +3615,6 @@ subroutine FAST_UnPackBeamDyn_Data(RF, OutData) call BD_UnpackParam(RF, OutData%p(i1)) ! p end do end if - if (allocated(OutData%u)) deallocate(OutData%u) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call BD_UnpackInput(RF, OutData%u(i1)) ! u - end do - end if if (allocated(OutData%y)) deallocate(OutData%y) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -7479,193 +3641,180 @@ subroutine FAST_UnPackBeamDyn_Data(RF, OutData) call BD_UnpackMisc(RF, OutData%m(i1)) ! m end do end if - if (allocated(OutData%Output)) deallocate(OutData%Output) + if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1),LB(2):UB(2)),stat=stat) + allocate(OutData%Input(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_UnpackOutput(RF, OutData%Output(i1,i2)) ! Output + call BD_UnpackInput(RF, OutData%Input(i1,i2)) ! Input end do end do end if - if (allocated(OutData%y_interp)) deallocate(OutData%y_interp) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%y_interp(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(ElastoDyn_Data), intent(inout) :: SrcElastoDyn_DataData + type(ElastoDyn_Data), intent(inout) :: DstElastoDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyElastoDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcElastoDyn_DataData%x)) then + LB(1:2) = lbound(SrcElastoDyn_DataData%x) + UB(1:2) = ubound(SrcElastoDyn_DataData%x) + if (.not. allocated(DstElastoDyn_DataData%x)) then + allocate(DstElastoDyn_DataData%x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i1 = LB(1), UB(1) - call BD_UnpackOutput(RF, OutData%y_interp(i1)) ! y_interp + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_CopyContState(SrcElastoDyn_DataData%x(i1,i2), DstElastoDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end do end if - if (allocated(OutData%Input)) deallocate(OutData%Input) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + if (allocated(SrcElastoDyn_DataData%xd)) then + LB(1:2) = lbound(SrcElastoDyn_DataData%xd) + UB(1:2) = ubound(SrcElastoDyn_DataData%xd) + if (.not. allocated(DstElastoDyn_DataData%xd)) then + allocate(DstElastoDyn_DataData%xd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_CopyDiscState(SrcElastoDyn_DataData%xd(i1,i2), DstElastoDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcElastoDyn_DataData%z)) then + LB(1:2) = lbound(SrcElastoDyn_DataData%z) + UB(1:2) = ubound(SrcElastoDyn_DataData%z) + if (.not. allocated(DstElastoDyn_DataData%z)) then + allocate(DstElastoDyn_DataData%z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_UnpackInput(RF, OutData%Input(i1,i2)) ! Input + call ED_CopyConstrState(SrcElastoDyn_DataData%z(i1,i2), DstElastoDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + if (allocated(SrcElastoDyn_DataData%OtherSt)) then + LB(1:2) = lbound(SrcElastoDyn_DataData%OtherSt) + UB(1:2) = ubound(SrcElastoDyn_DataData%OtherSt) + if (.not. allocated(DstElastoDyn_DataData%OtherSt)) then + allocate(DstElastoDyn_DataData%OtherSt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_UnpackInput(RF, OutData%Input_Saved(i1,i2)) ! Input_Saved + call ED_CopyOtherState(SrcElastoDyn_DataData%OtherSt(i1,i2), DstElastoDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end do end if - call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, CtrlCode, ErrStat, ErrMsg) - type(ElastoDyn_Data), intent(inout) :: SrcElastoDyn_DataData - type(ElastoDyn_Data), intent(inout) :: DstElastoDyn_DataData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'FAST_CopyElastoDyn_Data' - ErrStat = ErrID_None - ErrMsg = '' - LB(1:1) = lbound(SrcElastoDyn_DataData%x) - UB(1:1) = ubound(SrcElastoDyn_DataData%x) - do i1 = LB(1), UB(1) - call ED_CopyContState(SrcElastoDyn_DataData%x(i1), DstElastoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcElastoDyn_DataData%xd) - UB(1:1) = ubound(SrcElastoDyn_DataData%xd) - do i1 = LB(1), UB(1) - call ED_CopyDiscState(SrcElastoDyn_DataData%xd(i1), DstElastoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcElastoDyn_DataData%z) - UB(1:1) = ubound(SrcElastoDyn_DataData%z) - do i1 = LB(1), UB(1) - call ED_CopyConstrState(SrcElastoDyn_DataData%z(i1), DstElastoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcElastoDyn_DataData%OtherSt) - UB(1:1) = ubound(SrcElastoDyn_DataData%OtherSt) - do i1 = LB(1), UB(1) - call ED_CopyOtherState(SrcElastoDyn_DataData%OtherSt(i1), DstElastoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - call ED_CopyParam(SrcElastoDyn_DataData%p, DstElastoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call ED_CopyInput(SrcElastoDyn_DataData%u, DstElastoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call ED_CopyOutput(SrcElastoDyn_DataData%y, DstElastoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call ED_CopyMisc(SrcElastoDyn_DataData%m, DstElastoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcElastoDyn_DataData%Output)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%Output) - UB(1:1) = ubound(SrcElastoDyn_DataData%Output) - if (.not. allocated(DstElastoDyn_DataData%Output)) then - allocate(DstElastoDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcElastoDyn_DataData%p)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%p) + UB(1:1) = ubound(SrcElastoDyn_DataData%p) + if (.not. allocated(DstElastoDyn_DataData%p)) then + allocate(DstElastoDyn_DataData%p(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%p.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call ED_CopyOutput(SrcElastoDyn_DataData%Output(i1), DstElastoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call ED_CopyParam(SrcElastoDyn_DataData%p(i1), DstElastoDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcElastoDyn_DataData%Output_bak)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%Output_bak) - UB(1:1) = ubound(SrcElastoDyn_DataData%Output_bak) - if (.not. allocated(DstElastoDyn_DataData%Output_bak)) then - allocate(DstElastoDyn_DataData%Output_bak(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcElastoDyn_DataData%y)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%y) + UB(1:1) = ubound(SrcElastoDyn_DataData%y) + if (.not. allocated(DstElastoDyn_DataData%y)) then + allocate(DstElastoDyn_DataData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Output_bak.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%y.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call ED_CopyOutput(SrcElastoDyn_DataData%Output_bak(i1), DstElastoDyn_DataData%Output_bak(i1), CtrlCode, ErrStat2, ErrMsg2) + call ED_CopyOutput(SrcElastoDyn_DataData%y(i1), DstElastoDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - call ED_CopyOutput(SrcElastoDyn_DataData%y_interp, DstElastoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcElastoDyn_DataData%Input)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%Input) - UB(1:1) = ubound(SrcElastoDyn_DataData%Input) - if (.not. allocated(DstElastoDyn_DataData%Input)) then - allocate(DstElastoDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcElastoDyn_DataData%m)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%m) + UB(1:1) = ubound(SrcElastoDyn_DataData%m) + if (.not. allocated(DstElastoDyn_DataData%m)) then + allocate(DstElastoDyn_DataData%m(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%m.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call ED_CopyInput(SrcElastoDyn_DataData%Input(i1), DstElastoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call ED_CopyMisc(SrcElastoDyn_DataData%m(i1), DstElastoDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcElastoDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%Input_Saved) - UB(1:1) = ubound(SrcElastoDyn_DataData%Input_Saved) - if (.not. allocated(DstElastoDyn_DataData%Input_Saved)) then - allocate(DstElastoDyn_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcElastoDyn_DataData%Input)) then + LB(1:2) = lbound(SrcElastoDyn_DataData%Input) + UB(1:2) = ubound(SrcElastoDyn_DataData%Input) + if (.not. allocated(DstElastoDyn_DataData%Input)) then + allocate(DstElastoDyn_DataData%Input(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call ED_CopyInput(SrcElastoDyn_DataData%Input_Saved(i1), DstElastoDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_CopyInput(SrcElastoDyn_DataData%Input(i1,i2), DstElastoDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end do end if if (allocated(SrcElastoDyn_DataData%InputTimes)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%InputTimes) - UB(1:1) = ubound(SrcElastoDyn_DataData%InputTimes) + LB(1:2) = lbound(SrcElastoDyn_DataData%InputTimes) + UB(1:2) = ubound(SrcElastoDyn_DataData%InputTimes) if (.not. allocated(DstElastoDyn_DataData%InputTimes)) then - allocate(DstElastoDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + allocate(DstElastoDyn_DataData%InputTimes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) return @@ -7673,270 +3822,323 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, end if DstElastoDyn_DataData%InputTimes = SrcElastoDyn_DataData%InputTimes end if - if (allocated(SrcElastoDyn_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%InputTimes_Saved) - UB(1:1) = ubound(SrcElastoDyn_DataData%InputTimes_Saved) - if (.not. allocated(DstElastoDyn_DataData%InputTimes_Saved)) then - allocate(DstElastoDyn_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstElastoDyn_DataData%InputTimes_Saved = SrcElastoDyn_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) type(ElastoDyn_Data), intent(inout) :: ElastoDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyElastoDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(ElastoDyn_DataData%x) - UB(1:1) = ubound(ElastoDyn_DataData%x) - do i1 = LB(1), UB(1) - call ED_DestroyContState(ElastoDyn_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(ElastoDyn_DataData%xd) - UB(1:1) = ubound(ElastoDyn_DataData%xd) - do i1 = LB(1), UB(1) - call ED_DestroyDiscState(ElastoDyn_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(ElastoDyn_DataData%z) - UB(1:1) = ubound(ElastoDyn_DataData%z) - do i1 = LB(1), UB(1) - call ED_DestroyConstrState(ElastoDyn_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(ElastoDyn_DataData%OtherSt) - UB(1:1) = ubound(ElastoDyn_DataData%OtherSt) - do i1 = LB(1), UB(1) - call ED_DestroyOtherState(ElastoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - call ED_DestroyParam(ElastoDyn_DataData%p, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ED_DestroyInput(ElastoDyn_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ED_DestroyOutput(ElastoDyn_DataData%y, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ED_DestroyMisc(ElastoDyn_DataData%m, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(ElastoDyn_DataData%Output)) then - LB(1:1) = lbound(ElastoDyn_DataData%Output) - UB(1:1) = ubound(ElastoDyn_DataData%Output) - do i1 = LB(1), UB(1) - call ED_DestroyOutput(ElastoDyn_DataData%Output(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ElastoDyn_DataData%x)) then + LB(1:2) = lbound(ElastoDyn_DataData%x) + UB(1:2) = ubound(ElastoDyn_DataData%x) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_DestroyContState(ElastoDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ElastoDyn_DataData%x) + end if + if (allocated(ElastoDyn_DataData%xd)) then + LB(1:2) = lbound(ElastoDyn_DataData%xd) + UB(1:2) = ubound(ElastoDyn_DataData%xd) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_DestroyDiscState(ElastoDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ElastoDyn_DataData%xd) + end if + if (allocated(ElastoDyn_DataData%z)) then + LB(1:2) = lbound(ElastoDyn_DataData%z) + UB(1:2) = ubound(ElastoDyn_DataData%z) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_DestroyConstrState(ElastoDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ElastoDyn_DataData%z) + end if + if (allocated(ElastoDyn_DataData%OtherSt)) then + LB(1:2) = lbound(ElastoDyn_DataData%OtherSt) + UB(1:2) = ubound(ElastoDyn_DataData%OtherSt) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_DestroyOtherState(ElastoDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do end do - deallocate(ElastoDyn_DataData%Output) + deallocate(ElastoDyn_DataData%OtherSt) end if - if (allocated(ElastoDyn_DataData%Output_bak)) then - LB(1:1) = lbound(ElastoDyn_DataData%Output_bak) - UB(1:1) = ubound(ElastoDyn_DataData%Output_bak) + if (allocated(ElastoDyn_DataData%p)) then + LB(1:1) = lbound(ElastoDyn_DataData%p) + UB(1:1) = ubound(ElastoDyn_DataData%p) do i1 = LB(1), UB(1) - call ED_DestroyOutput(ElastoDyn_DataData%Output_bak(i1), ErrStat2, ErrMsg2) + call ED_DestroyParam(ElastoDyn_DataData%p(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(ElastoDyn_DataData%Output_bak) + deallocate(ElastoDyn_DataData%p) end if - call ED_DestroyOutput(ElastoDyn_DataData%y_interp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(ElastoDyn_DataData%Input)) then - LB(1:1) = lbound(ElastoDyn_DataData%Input) - UB(1:1) = ubound(ElastoDyn_DataData%Input) + if (allocated(ElastoDyn_DataData%y)) then + LB(1:1) = lbound(ElastoDyn_DataData%y) + UB(1:1) = ubound(ElastoDyn_DataData%y) do i1 = LB(1), UB(1) - call ED_DestroyInput(ElastoDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call ED_DestroyOutput(ElastoDyn_DataData%y(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(ElastoDyn_DataData%Input) + deallocate(ElastoDyn_DataData%y) end if - if (allocated(ElastoDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(ElastoDyn_DataData%Input_Saved) - UB(1:1) = ubound(ElastoDyn_DataData%Input_Saved) + if (allocated(ElastoDyn_DataData%m)) then + LB(1:1) = lbound(ElastoDyn_DataData%m) + UB(1:1) = ubound(ElastoDyn_DataData%m) do i1 = LB(1), UB(1) - call ED_DestroyInput(ElastoDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) + call ED_DestroyMisc(ElastoDyn_DataData%m(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(ElastoDyn_DataData%Input_Saved) + deallocate(ElastoDyn_DataData%m) + end if + if (allocated(ElastoDyn_DataData%Input)) then + LB(1:2) = lbound(ElastoDyn_DataData%Input) + UB(1:2) = ubound(ElastoDyn_DataData%Input) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_DestroyInput(ElastoDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ElastoDyn_DataData%Input) end if if (allocated(ElastoDyn_DataData%InputTimes)) then deallocate(ElastoDyn_DataData%InputTimes) end if - if (allocated(ElastoDyn_DataData%InputTimes_Saved)) then - deallocate(ElastoDyn_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackElastoDyn_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(ElastoDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackElastoDyn_Data' - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) - do i1 = LB(1), UB(1) - call ED_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) - do i1 = LB(1), UB(1) - call ED_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) - do i1 = LB(1), UB(1) - call ED_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) - do i1 = LB(1), UB(1) - call ED_PackOtherState(RF, InData%OtherSt(i1)) - end do - call ED_PackParam(RF, InData%p) - call ED_PackInput(RF, InData%u) - call ED_PackOutput(RF, InData%y) - call ED_PackMisc(RF, InData%m) - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 2, lbound(InData%x), ubound(InData%x)) + LB(1:2) = lbound(InData%x) + UB(1:2) = ubound(InData%x) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_PackContState(RF, InData%x(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 2, lbound(InData%xd), ubound(InData%xd)) + LB(1:2) = lbound(InData%xd) + UB(1:2) = ubound(InData%xd) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_PackDiscState(RF, InData%xd(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 2, lbound(InData%z), ubound(InData%z)) + LB(1:2) = lbound(InData%z) + UB(1:2) = ubound(InData%z) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_PackConstrState(RF, InData%z(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 2, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:2) = lbound(InData%OtherSt) + UB(1:2) = ubound(InData%OtherSt) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_PackOtherState(RF, InData%OtherSt(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%p)) + if (allocated(InData%p)) then + call RegPackBounds(RF, 1, lbound(InData%p), ubound(InData%p)) + LB(1:1) = lbound(InData%p) + UB(1:1) = ubound(InData%p) + do i1 = LB(1), UB(1) + call ED_PackParam(RF, InData%p(i1)) + end do + end if + call RegPack(RF, allocated(InData%y)) + if (allocated(InData%y)) then + call RegPackBounds(RF, 1, lbound(InData%y), ubound(InData%y)) + LB(1:1) = lbound(InData%y) + UB(1:1) = ubound(InData%y) do i1 = LB(1), UB(1) - call ED_PackOutput(RF, InData%Output(i1)) + call ED_PackOutput(RF, InData%y(i1)) end do end if - call RegPack(RF, allocated(InData%Output_bak)) - if (allocated(InData%Output_bak)) then - call RegPackBounds(RF, 1, lbound(InData%Output_bak), ubound(InData%Output_bak)) - LB(1:1) = lbound(InData%Output_bak) - UB(1:1) = ubound(InData%Output_bak) + call RegPack(RF, allocated(InData%m)) + if (allocated(InData%m)) then + call RegPackBounds(RF, 1, lbound(InData%m), ubound(InData%m)) + LB(1:1) = lbound(InData%m) + UB(1:1) = ubound(InData%m) do i1 = LB(1), UB(1) - call ED_PackOutput(RF, InData%Output_bak(i1)) + call ED_PackMisc(RF, InData%m(i1)) + end do + end if + call RegPack(RF, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(RF, 2, lbound(InData%Input), ubound(InData%Input)) + LB(1:2) = lbound(InData%Input) + UB(1:2) = ubound(InData%Input) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_PackInput(RF, InData%Input(i1,i2)) + end do + end do + end if + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackElastoDyn_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ElastoDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackElastoDyn_Data' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_UnpackContState(RF, OutData%x(i1,i2)) ! x + end do + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_UnpackDiscState(RF, OutData%xd(i1,i2)) ! xd + end do end do end if - call ED_PackOutput(RF, InData%y_interp) - call RegPack(RF, allocated(InData%Input)) - if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) - LB(1:1) = lbound(InData%Input) - UB(1:1) = ubound(InData%Input) - do i1 = LB(1), UB(1) - call ED_PackInput(RF, InData%Input(i1)) + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_UnpackConstrState(RF, OutData%z(i1,i2)) ! z + end do end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) - LB(1:1) = lbound(InData%Input_Saved) - UB(1:1) = ubound(InData%Input_Saved) - do i1 = LB(1), UB(1) - call ED_PackInput(RF, InData%Input_Saved(i1)) + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_UnpackOtherState(RF, OutData%OtherSt(i1,i2)) ! OtherSt + end do end do end if - call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_UnPackElastoDyn_Data(RF, OutData) - type(RegFile), intent(inout) :: RF - type(ElastoDyn_Data), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackElastoDyn_Data' - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) - do i1 = LB(1), UB(1) - call ED_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) - do i1 = LB(1), UB(1) - call ED_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) - do i1 = LB(1), UB(1) - call ED_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) - do i1 = LB(1), UB(1) - call ED_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do - call ED_UnpackParam(RF, OutData%p) ! p - call ED_UnpackInput(RF, OutData%u) ! u - call ED_UnpackOutput(RF, OutData%y) ! y - call ED_UnpackMisc(RF, OutData%m) ! m - if (allocated(OutData%Output)) deallocate(OutData%Output) + if (allocated(OutData%p)) deallocate(OutData%p) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) + allocate(OutData%p(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ED_UnpackOutput(RF, OutData%Output(i1)) ! Output + call ED_UnpackParam(RF, OutData%p(i1)) ! p end do end if - if (allocated(OutData%Output_bak)) deallocate(OutData%Output_bak) + if (allocated(OutData%y)) deallocate(OutData%y) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output_bak(LB(1):UB(1)),stat=stat) + allocate(OutData%y(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output_bak.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ED_UnpackOutput(RF, OutData%Output_bak(i1)) ! Output_bak + call ED_UnpackOutput(RF, OutData%y(i1)) ! y end do end if - call ED_UnpackOutput(RF, OutData%y_interp) ! y_interp - if (allocated(OutData%Input)) deallocate(OutData%Input) + if (allocated(OutData%m)) deallocate(OutData%m) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input(LB(1):UB(1)),stat=stat) + allocate(OutData%m(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ED_UnpackInput(RF, OutData%Input(i1)) ! Input + call ED_UnpackMisc(RF, OutData%m(i1)) ! m end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - do i1 = LB(1), UB(1) - call ED_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call ED_UnpackInput(RF, OutData%Input(i1,i2)) ! Input + end do end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopySED_Data(SrcSED_DataData, DstSED_DataData, CtrlCode, ErrStat, ErrMsg) @@ -7952,63 +4154,77 @@ subroutine FAST_CopySED_Data(SrcSED_DataData, DstSED_DataData, CtrlCode, ErrStat character(*), parameter :: RoutineName = 'FAST_CopySED_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcSED_DataData%x) - UB(1:1) = ubound(SrcSED_DataData%x) - do i1 = LB(1), UB(1) - call SED_CopyContState(SrcSED_DataData%x(i1), DstSED_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcSED_DataData%xd) - UB(1:1) = ubound(SrcSED_DataData%xd) - do i1 = LB(1), UB(1) - call SED_CopyDiscState(SrcSED_DataData%xd(i1), DstSED_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcSED_DataData%z) - UB(1:1) = ubound(SrcSED_DataData%z) - do i1 = LB(1), UB(1) - call SED_CopyConstrState(SrcSED_DataData%z(i1), DstSED_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcSED_DataData%OtherSt) - UB(1:1) = ubound(SrcSED_DataData%OtherSt) - do i1 = LB(1), UB(1) - call SED_CopyOtherState(SrcSED_DataData%OtherSt(i1), DstSED_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - call SED_CopyParam(SrcSED_DataData%p, DstSED_DataData%p, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SED_CopyInput(SrcSED_DataData%u, DstSED_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SED_CopyOutput(SrcSED_DataData%y, DstSED_DataData%y, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SED_CopyMisc(SrcSED_DataData%m, DstSED_DataData%m, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcSED_DataData%Output)) then - LB(1:1) = lbound(SrcSED_DataData%Output) - UB(1:1) = ubound(SrcSED_DataData%Output) - if (.not. allocated(DstSED_DataData%Output)) then - allocate(DstSED_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcSED_DataData%x)) then + LB(1:1) = lbound(SrcSED_DataData%x) + UB(1:1) = ubound(SrcSED_DataData%x) + if (.not. allocated(DstSED_DataData%x)) then + allocate(DstSED_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSED_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SED_CopyContState(SrcSED_DataData%x(i1), DstSED_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcSED_DataData%xd)) then + LB(1:1) = lbound(SrcSED_DataData%xd) + UB(1:1) = ubound(SrcSED_DataData%xd) + if (.not. allocated(DstSED_DataData%xd)) then + allocate(DstSED_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSED_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SED_CopyDiscState(SrcSED_DataData%xd(i1), DstSED_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcSED_DataData%z)) then + LB(1:1) = lbound(SrcSED_DataData%z) + UB(1:1) = ubound(SrcSED_DataData%z) + if (.not. allocated(DstSED_DataData%z)) then + allocate(DstSED_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSED_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SED_CopyConstrState(SrcSED_DataData%z(i1), DstSED_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcSED_DataData%OtherSt)) then + LB(1:1) = lbound(SrcSED_DataData%OtherSt) + UB(1:1) = ubound(SrcSED_DataData%OtherSt) + if (.not. allocated(DstSED_DataData%OtherSt)) then + allocate(DstSED_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstSED_DataData%Output.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstSED_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call SED_CopyOutput(SrcSED_DataData%Output(i1), DstSED_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SED_CopyOtherState(SrcSED_DataData%OtherSt(i1), DstSED_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - call SED_CopyOutput(SrcSED_DataData%y_interp, DstSED_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SED_CopyParam(SrcSED_DataData%p, DstSED_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SED_CopyOutput(SrcSED_DataData%y, DstSED_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SED_CopyMisc(SrcSED_DataData%m, DstSED_DataData%m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcSED_DataData%Input)) then @@ -8052,49 +4268,48 @@ subroutine FAST_DestroySED_Data(SED_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroySED_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SED_DataData%x) - UB(1:1) = ubound(SED_DataData%x) - do i1 = LB(1), UB(1) - call SED_DestroyContState(SED_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(SED_DataData%xd) - UB(1:1) = ubound(SED_DataData%xd) - do i1 = LB(1), UB(1) - call SED_DestroyDiscState(SED_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(SED_DataData%z) - UB(1:1) = ubound(SED_DataData%z) - do i1 = LB(1), UB(1) - call SED_DestroyConstrState(SED_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(SED_DataData%OtherSt) - UB(1:1) = ubound(SED_DataData%OtherSt) - do i1 = LB(1), UB(1) - call SED_DestroyOtherState(SED_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(SED_DataData%x)) then + LB(1:1) = lbound(SED_DataData%x) + UB(1:1) = ubound(SED_DataData%x) + do i1 = LB(1), UB(1) + call SED_DestroyContState(SED_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SED_DataData%x) + end if + if (allocated(SED_DataData%xd)) then + LB(1:1) = lbound(SED_DataData%xd) + UB(1:1) = ubound(SED_DataData%xd) + do i1 = LB(1), UB(1) + call SED_DestroyDiscState(SED_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SED_DataData%xd) + end if + if (allocated(SED_DataData%z)) then + LB(1:1) = lbound(SED_DataData%z) + UB(1:1) = ubound(SED_DataData%z) + do i1 = LB(1), UB(1) + call SED_DestroyConstrState(SED_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SED_DataData%z) + end if + if (allocated(SED_DataData%OtherSt)) then + LB(1:1) = lbound(SED_DataData%OtherSt) + UB(1:1) = ubound(SED_DataData%OtherSt) + do i1 = LB(1), UB(1) + call SED_DestroyOtherState(SED_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SED_DataData%OtherSt) + end if call SED_DestroyParam(SED_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SED_DestroyInput(SED_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SED_DestroyOutput(SED_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SED_DestroyMisc(SED_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(SED_DataData%Output)) then - LB(1:1) = lbound(SED_DataData%Output) - UB(1:1) = ubound(SED_DataData%Output) - do i1 = LB(1), UB(1) - call SED_DestroyOutput(SED_DataData%Output(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(SED_DataData%Output) - end if - call SED_DestroyOutput(SED_DataData%y_interp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(SED_DataData%Input)) then LB(1:1) = lbound(SED_DataData%Input) UB(1:1) = ubound(SED_DataData%Input) @@ -8116,100 +4331,122 @@ subroutine FAST_PackSED_Data(RF, Indata) integer(B4Ki) :: i1 integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) - do i1 = LB(1), UB(1) - call SED_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) - do i1 = LB(1), UB(1) - call SED_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) - do i1 = LB(1), UB(1) - call SED_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) - do i1 = LB(1), UB(1) - call SED_PackOtherState(RF, InData%OtherSt(i1)) - end do + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call SED_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call SED_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call SED_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call SED_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if call SED_PackParam(RF, InData%p) - call SED_PackInput(RF, InData%u) call SED_PackOutput(RF, InData%y) call SED_PackMisc(RF, InData%m) - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) + call RegPack(RF, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call SED_PackInput(RF, InData%Input(i1)) + end do + end if + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackSED_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SED_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackSED_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SED_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if do i1 = LB(1), UB(1) - call SED_PackOutput(RF, InData%Output(i1)) + call SED_UnpackDiscState(RF, OutData%xd(i1)) ! xd end do end if - call SED_PackOutput(RF, InData%y_interp) - call RegPack(RF, allocated(InData%Input)) - if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) - LB(1:1) = lbound(InData%Input) - UB(1:1) = ubound(InData%Input) + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if do i1 = LB(1), UB(1) - call SED_PackInput(RF, InData%Input(i1)) + call SED_UnpackConstrState(RF, OutData%z(i1)) ! z end do end if - call RegPackAlloc(RF, InData%InputTimes) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_UnPackSED_Data(RF, OutData) - type(RegFile), intent(inout) :: RF - type(SED_Data), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackSED_Data' - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) - do i1 = LB(1), UB(1) - call SED_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) - do i1 = LB(1), UB(1) - call SED_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) - do i1 = LB(1), UB(1) - call SED_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) - do i1 = LB(1), UB(1) - call SED_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do - call SED_UnpackParam(RF, OutData%p) ! p - call SED_UnpackInput(RF, OutData%u) ! u - call SED_UnpackOutput(RF, OutData%y) ! y - call SED_UnpackMisc(RF, OutData%m) ! m - if (allocated(OutData%Output)) deallocate(OutData%Output) + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SED_UnpackOutput(RF, OutData%Output(i1)) ! Output + call SED_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do end if - call SED_UnpackOutput(RF, OutData%y_interp) ! y_interp + call SED_UnpackParam(RF, OutData%p) ! p + call SED_UnpackOutput(RF, OutData%y) ! y + call SED_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -8239,96 +4476,91 @@ subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, Ct character(*), parameter :: RoutineName = 'FAST_CopyServoDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcServoDyn_DataData%x) - UB(1:1) = ubound(SrcServoDyn_DataData%x) - do i1 = LB(1), UB(1) - call SrvD_CopyContState(SrcServoDyn_DataData%x(i1), DstServoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcServoDyn_DataData%xd) - UB(1:1) = ubound(SrcServoDyn_DataData%xd) - do i1 = LB(1), UB(1) - call SrvD_CopyDiscState(SrcServoDyn_DataData%xd(i1), DstServoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcServoDyn_DataData%z) - UB(1:1) = ubound(SrcServoDyn_DataData%z) - do i1 = LB(1), UB(1) - call SrvD_CopyConstrState(SrcServoDyn_DataData%z(i1), DstServoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcServoDyn_DataData%OtherSt) - UB(1:1) = ubound(SrcServoDyn_DataData%OtherSt) - do i1 = LB(1), UB(1) - call SrvD_CopyOtherState(SrcServoDyn_DataData%OtherSt(i1), DstServoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - call SrvD_CopyParam(SrcServoDyn_DataData%p, DstServoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SrvD_CopyInput(SrcServoDyn_DataData%u, DstServoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SrvD_CopyOutput(SrcServoDyn_DataData%y, DstServoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SrvD_CopyMisc(SrcServoDyn_DataData%m, DstServoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SrvD_CopyMisc(SrcServoDyn_DataData%m_bak, DstServoDyn_DataData%m_bak, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcServoDyn_DataData%Output)) then - LB(1:1) = lbound(SrcServoDyn_DataData%Output) - UB(1:1) = ubound(SrcServoDyn_DataData%Output) - if (.not. allocated(DstServoDyn_DataData%Output)) then - allocate(DstServoDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcServoDyn_DataData%x)) then + LB(1:1) = lbound(SrcServoDyn_DataData%x) + UB(1:1) = ubound(SrcServoDyn_DataData%x) + if (.not. allocated(DstServoDyn_DataData%x)) then + allocate(DstServoDyn_DataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%x.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call SrvD_CopyOutput(SrcServoDyn_DataData%Output(i1), DstServoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SrvD_CopyContState(SrcServoDyn_DataData%x(i1), DstServoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - call SrvD_CopyOutput(SrcServoDyn_DataData%y_interp, DstServoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcServoDyn_DataData%Input)) then - LB(1:1) = lbound(SrcServoDyn_DataData%Input) - UB(1:1) = ubound(SrcServoDyn_DataData%Input) - if (.not. allocated(DstServoDyn_DataData%Input)) then - allocate(DstServoDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcServoDyn_DataData%xd)) then + LB(1:1) = lbound(SrcServoDyn_DataData%xd) + UB(1:1) = ubound(SrcServoDyn_DataData%xd) + if (.not. allocated(DstServoDyn_DataData%xd)) then + allocate(DstServoDyn_DataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%xd.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call SrvD_CopyInput(SrcServoDyn_DataData%Input(i1), DstServoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SrvD_CopyDiscState(SrcServoDyn_DataData%xd(i1), DstServoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcServoDyn_DataData%z)) then + LB(1:1) = lbound(SrcServoDyn_DataData%z) + UB(1:1) = ubound(SrcServoDyn_DataData%z) + if (.not. allocated(DstServoDyn_DataData%z)) then + allocate(DstServoDyn_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SrvD_CopyConstrState(SrcServoDyn_DataData%z(i1), DstServoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcServoDyn_DataData%OtherSt)) then + LB(1:1) = lbound(SrcServoDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcServoDyn_DataData%OtherSt) + if (.not. allocated(DstServoDyn_DataData%OtherSt)) then + allocate(DstServoDyn_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SrvD_CopyOtherState(SrcServoDyn_DataData%OtherSt(i1), DstServoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcServoDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcServoDyn_DataData%Input_Saved) - UB(1:1) = ubound(SrcServoDyn_DataData%Input_Saved) - if (.not. allocated(DstServoDyn_DataData%Input_Saved)) then - allocate(DstServoDyn_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + 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_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 + LB(1:1) = lbound(SrcServoDyn_DataData%Input) + UB(1:1) = ubound(SrcServoDyn_DataData%Input) + if (.not. allocated(DstServoDyn_DataData%Input)) then + allocate(DstServoDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call SrvD_CopyInput(SrcServoDyn_DataData%Input_Saved(i1), DstServoDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + call SrvD_CopyInput(SrcServoDyn_DataData%Input(i1), DstServoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do @@ -8345,18 +4577,6 @@ subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, Ct end if DstServoDyn_DataData%InputTimes = SrcServoDyn_DataData%InputTimes end if - if (allocated(SrcServoDyn_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcServoDyn_DataData%InputTimes_Saved) - UB(1:1) = ubound(SrcServoDyn_DataData%InputTimes_Saved) - if (.not. allocated(DstServoDyn_DataData%InputTimes_Saved)) then - allocate(DstServoDyn_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstServoDyn_DataData%InputTimes_Saved = SrcServoDyn_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) @@ -8370,51 +4590,48 @@ subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyServoDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(ServoDyn_DataData%x) - UB(1:1) = ubound(ServoDyn_DataData%x) - do i1 = LB(1), UB(1) - call SrvD_DestroyContState(ServoDyn_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(ServoDyn_DataData%xd) - UB(1:1) = ubound(ServoDyn_DataData%xd) - do i1 = LB(1), UB(1) - call SrvD_DestroyDiscState(ServoDyn_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(ServoDyn_DataData%z) - UB(1:1) = ubound(ServoDyn_DataData%z) - do i1 = LB(1), UB(1) - call SrvD_DestroyConstrState(ServoDyn_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(ServoDyn_DataData%OtherSt) - UB(1:1) = ubound(ServoDyn_DataData%OtherSt) - do i1 = LB(1), UB(1) - call SrvD_DestroyOtherState(ServoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(ServoDyn_DataData%x)) then + LB(1:1) = lbound(ServoDyn_DataData%x) + UB(1:1) = ubound(ServoDyn_DataData%x) + do i1 = LB(1), UB(1) + call SrvD_DestroyContState(ServoDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ServoDyn_DataData%x) + end if + if (allocated(ServoDyn_DataData%xd)) then + LB(1:1) = lbound(ServoDyn_DataData%xd) + UB(1:1) = ubound(ServoDyn_DataData%xd) + do i1 = LB(1), UB(1) + call SrvD_DestroyDiscState(ServoDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ServoDyn_DataData%xd) + end if + if (allocated(ServoDyn_DataData%z)) then + LB(1:1) = lbound(ServoDyn_DataData%z) + UB(1:1) = ubound(ServoDyn_DataData%z) + do i1 = LB(1), UB(1) + call SrvD_DestroyConstrState(ServoDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ServoDyn_DataData%z) + end if + if (allocated(ServoDyn_DataData%OtherSt)) then + LB(1:1) = lbound(ServoDyn_DataData%OtherSt) + UB(1:1) = ubound(ServoDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call SrvD_DestroyOtherState(ServoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ServoDyn_DataData%OtherSt) + end if call SrvD_DestroyParam(ServoDyn_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SrvD_DestroyInput(ServoDyn_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SrvD_DestroyOutput(ServoDyn_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SrvD_DestroyMisc(ServoDyn_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SrvD_DestroyMisc(ServoDyn_DataData%m_bak, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(ServoDyn_DataData%Output)) then - LB(1:1) = lbound(ServoDyn_DataData%Output) - UB(1:1) = ubound(ServoDyn_DataData%Output) - do i1 = LB(1), UB(1) - call SrvD_DestroyOutput(ServoDyn_DataData%Output(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ServoDyn_DataData%Output) - end if - call SrvD_DestroyOutput(ServoDyn_DataData%y_interp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ServoDyn_DataData%Input)) then LB(1:1) = lbound(ServoDyn_DataData%Input) UB(1:1) = ubound(ServoDyn_DataData%Input) @@ -8424,21 +4641,9 @@ subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) end do deallocate(ServoDyn_DataData%Input) end if - if (allocated(ServoDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(ServoDyn_DataData%Input_Saved) - UB(1:1) = ubound(ServoDyn_DataData%Input_Saved) - do i1 = LB(1), UB(1) - call SrvD_DestroyInput(ServoDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ServoDyn_DataData%Input_Saved) - end if if (allocated(ServoDyn_DataData%InputTimes)) then deallocate(ServoDyn_DataData%InputTimes) end if - if (allocated(ServoDyn_DataData%InputTimes_Saved)) then - deallocate(ServoDyn_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackServoDyn_Data(RF, Indata) @@ -8448,41 +4653,45 @@ subroutine FAST_PackServoDyn_Data(RF, Indata) integer(B4Ki) :: i1 integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) - do i1 = LB(1), UB(1) - call SrvD_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) - do i1 = LB(1), UB(1) - call SrvD_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) - do i1 = LB(1), UB(1) - call SrvD_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) - do i1 = LB(1), UB(1) - call SrvD_PackOtherState(RF, InData%OtherSt(i1)) - end do - call SrvD_PackParam(RF, InData%p) - call SrvD_PackInput(RF, InData%u) - call SrvD_PackOutput(RF, InData%y) - call SrvD_PackMisc(RF, InData%m) - call SrvD_PackMisc(RF, InData%m_bak) - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call SrvD_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call SrvD_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call SrvD_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) - call SrvD_PackOutput(RF, InData%Output(i1)) + call SrvD_PackOtherState(RF, InData%OtherSt(i1)) end do end if - call SrvD_PackOutput(RF, InData%y_interp) + call SrvD_PackParam(RF, InData%p) + call SrvD_PackOutput(RF, InData%y) + call SrvD_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) @@ -8492,17 +4701,7 @@ subroutine FAST_PackServoDyn_Data(RF, Indata) call SrvD_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) - LB(1:1) = lbound(InData%Input_Saved) - UB(1:1) = ubound(InData%Input_Saved) - do i1 = LB(1), UB(1) - call SrvD_PackInput(RF, InData%Input_Saved(i1)) - end do - end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -8515,73 +4714,75 @@ subroutine FAST_UnPackServoDyn_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) - do i1 = LB(1), UB(1) - call SrvD_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) - do i1 = LB(1), UB(1) - call SrvD_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) - do i1 = LB(1), UB(1) - call SrvD_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) - do i1 = LB(1), UB(1) - call SrvD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do - call SrvD_UnpackParam(RF, OutData%p) ! p - call SrvD_UnpackInput(RF, OutData%u) ! u - call SrvD_UnpackOutput(RF, OutData%y) ! y - call SrvD_UnpackMisc(RF, OutData%m) ! m - call SrvD_UnpackMisc(RF, OutData%m_bak) ! m_bak - if (allocated(OutData%Output)) deallocate(OutData%Output) + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) + allocate(OutData%z(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SrvD_UnpackOutput(RF, OutData%Output(i1)) ! Output + call SrvD_UnpackConstrState(RF, OutData%z(i1)) ! z end do end if - call SrvD_UnpackOutput(RF, OutData%y_interp) ! y_interp - if (allocated(OutData%Input)) deallocate(OutData%Input) + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input(LB(1):UB(1)),stat=stat) + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SrvD_UnpackInput(RF, OutData%Input(i1)) ! Input + call SrvD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call SrvD_UnpackParam(RF, OutData%p) ! p + call SrvD_UnpackOutput(RF, OutData%y) ! y + call SrvD_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SrvD_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + call SrvD_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlCode, ErrStat, ErrMsg) @@ -8597,93 +4798,91 @@ subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlC character(*), parameter :: RoutineName = 'FAST_CopyAeroDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcAeroDyn_DataData%x) - UB(1:1) = ubound(SrcAeroDyn_DataData%x) - do i1 = LB(1), UB(1) - call AD_CopyContState(SrcAeroDyn_DataData%x(i1), DstAeroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcAeroDyn_DataData%xd) - UB(1:1) = ubound(SrcAeroDyn_DataData%xd) - do i1 = LB(1), UB(1) - call AD_CopyDiscState(SrcAeroDyn_DataData%xd(i1), DstAeroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcAeroDyn_DataData%z) - UB(1:1) = ubound(SrcAeroDyn_DataData%z) - do i1 = LB(1), UB(1) - call AD_CopyConstrState(SrcAeroDyn_DataData%z(i1), DstAeroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcAeroDyn_DataData%OtherSt) - UB(1:1) = ubound(SrcAeroDyn_DataData%OtherSt) - do i1 = LB(1), UB(1) - call AD_CopyOtherState(SrcAeroDyn_DataData%OtherSt(i1), DstAeroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - call AD_CopyParam(SrcAeroDyn_DataData%p, DstAeroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call AD_CopyInput(SrcAeroDyn_DataData%u, DstAeroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call AD_CopyOutput(SrcAeroDyn_DataData%y, DstAeroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call AD_CopyMisc(SrcAeroDyn_DataData%m, DstAeroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcAeroDyn_DataData%Output)) then - LB(1:1) = lbound(SrcAeroDyn_DataData%Output) - UB(1:1) = ubound(SrcAeroDyn_DataData%Output) - if (.not. allocated(DstAeroDyn_DataData%Output)) then - allocate(DstAeroDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcAeroDyn_DataData%x)) then + LB(1:1) = lbound(SrcAeroDyn_DataData%x) + UB(1:1) = ubound(SrcAeroDyn_DataData%x) + if (.not. allocated(DstAeroDyn_DataData%x)) then + allocate(DstAeroDyn_DataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%x.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call AD_CopyOutput(SrcAeroDyn_DataData%Output(i1), DstAeroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call AD_CopyContState(SrcAeroDyn_DataData%x(i1), DstAeroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - call AD_CopyOutput(SrcAeroDyn_DataData%y_interp, DstAeroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcAeroDyn_DataData%Input)) then - LB(1:1) = lbound(SrcAeroDyn_DataData%Input) - UB(1:1) = ubound(SrcAeroDyn_DataData%Input) - if (.not. allocated(DstAeroDyn_DataData%Input)) then - allocate(DstAeroDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcAeroDyn_DataData%xd)) then + LB(1:1) = lbound(SrcAeroDyn_DataData%xd) + UB(1:1) = ubound(SrcAeroDyn_DataData%xd) + if (.not. allocated(DstAeroDyn_DataData%xd)) then + allocate(DstAeroDyn_DataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%xd.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call AD_CopyInput(SrcAeroDyn_DataData%Input(i1), DstAeroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call AD_CopyDiscState(SrcAeroDyn_DataData%xd(i1), DstAeroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcAeroDyn_DataData%z)) then + LB(1:1) = lbound(SrcAeroDyn_DataData%z) + UB(1:1) = ubound(SrcAeroDyn_DataData%z) + if (.not. allocated(DstAeroDyn_DataData%z)) then + allocate(DstAeroDyn_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyConstrState(SrcAeroDyn_DataData%z(i1), DstAeroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcAeroDyn_DataData%OtherSt)) then + LB(1:1) = lbound(SrcAeroDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcAeroDyn_DataData%OtherSt) + if (.not. allocated(DstAeroDyn_DataData%OtherSt)) then + allocate(DstAeroDyn_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyOtherState(SrcAeroDyn_DataData%OtherSt(i1), DstAeroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcAeroDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcAeroDyn_DataData%Input_Saved) - UB(1:1) = ubound(SrcAeroDyn_DataData%Input_Saved) - if (.not. allocated(DstAeroDyn_DataData%Input_Saved)) then - allocate(DstAeroDyn_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + 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_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 + LB(1:1) = lbound(SrcAeroDyn_DataData%Input) + UB(1:1) = ubound(SrcAeroDyn_DataData%Input) + if (.not. allocated(DstAeroDyn_DataData%Input)) then + allocate(DstAeroDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call AD_CopyInput(SrcAeroDyn_DataData%Input_Saved(i1), DstAeroDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + call AD_CopyInput(SrcAeroDyn_DataData%Input(i1), DstAeroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do @@ -8700,18 +4899,6 @@ subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlC end if DstAeroDyn_DataData%InputTimes = SrcAeroDyn_DataData%InputTimes end if - if (allocated(SrcAeroDyn_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcAeroDyn_DataData%InputTimes_Saved) - UB(1:1) = ubound(SrcAeroDyn_DataData%InputTimes_Saved) - if (.not. allocated(DstAeroDyn_DataData%InputTimes_Saved)) then - allocate(DstAeroDyn_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstAeroDyn_DataData%InputTimes_Saved = SrcAeroDyn_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) @@ -8725,49 +4912,48 @@ subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyAeroDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(AeroDyn_DataData%x) - UB(1:1) = ubound(AeroDyn_DataData%x) - do i1 = LB(1), UB(1) - call AD_DestroyContState(AeroDyn_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(AeroDyn_DataData%xd) - UB(1:1) = ubound(AeroDyn_DataData%xd) - do i1 = LB(1), UB(1) - call AD_DestroyDiscState(AeroDyn_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(AeroDyn_DataData%z) - UB(1:1) = ubound(AeroDyn_DataData%z) - do i1 = LB(1), UB(1) - call AD_DestroyConstrState(AeroDyn_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(AeroDyn_DataData%OtherSt) - UB(1:1) = ubound(AeroDyn_DataData%OtherSt) - do i1 = LB(1), UB(1) - call AD_DestroyOtherState(AeroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(AeroDyn_DataData%x)) then + LB(1:1) = lbound(AeroDyn_DataData%x) + UB(1:1) = ubound(AeroDyn_DataData%x) + do i1 = LB(1), UB(1) + call AD_DestroyContState(AeroDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDyn_DataData%x) + end if + if (allocated(AeroDyn_DataData%xd)) then + LB(1:1) = lbound(AeroDyn_DataData%xd) + UB(1:1) = ubound(AeroDyn_DataData%xd) + do i1 = LB(1), UB(1) + call AD_DestroyDiscState(AeroDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDyn_DataData%xd) + end if + if (allocated(AeroDyn_DataData%z)) then + LB(1:1) = lbound(AeroDyn_DataData%z) + UB(1:1) = ubound(AeroDyn_DataData%z) + do i1 = LB(1), UB(1) + call AD_DestroyConstrState(AeroDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDyn_DataData%z) + end if + if (allocated(AeroDyn_DataData%OtherSt)) then + LB(1:1) = lbound(AeroDyn_DataData%OtherSt) + UB(1:1) = ubound(AeroDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call AD_DestroyOtherState(AeroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDyn_DataData%OtherSt) + end if call AD_DestroyParam(AeroDyn_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AD_DestroyInput(AeroDyn_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call AD_DestroyOutput(AeroDyn_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call AD_DestroyMisc(AeroDyn_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(AeroDyn_DataData%Output)) then - LB(1:1) = lbound(AeroDyn_DataData%Output) - UB(1:1) = ubound(AeroDyn_DataData%Output) - do i1 = LB(1), UB(1) - call AD_DestroyOutput(AeroDyn_DataData%Output(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(AeroDyn_DataData%Output) - end if - call AD_DestroyOutput(AeroDyn_DataData%y_interp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(AeroDyn_DataData%Input)) then LB(1:1) = lbound(AeroDyn_DataData%Input) UB(1:1) = ubound(AeroDyn_DataData%Input) @@ -8777,21 +4963,9 @@ subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) end do deallocate(AeroDyn_DataData%Input) end if - if (allocated(AeroDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(AeroDyn_DataData%Input_Saved) - UB(1:1) = ubound(AeroDyn_DataData%Input_Saved) - do i1 = LB(1), UB(1) - call AD_DestroyInput(AeroDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(AeroDyn_DataData%Input_Saved) - end if if (allocated(AeroDyn_DataData%InputTimes)) then deallocate(AeroDyn_DataData%InputTimes) end if - if (allocated(AeroDyn_DataData%InputTimes_Saved)) then - deallocate(AeroDyn_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackAeroDyn_Data(RF, Indata) @@ -8801,40 +4975,45 @@ subroutine FAST_PackAeroDyn_Data(RF, Indata) integer(B4Ki) :: i1 integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) - do i1 = LB(1), UB(1) - call AD_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) - do i1 = LB(1), UB(1) - call AD_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) - do i1 = LB(1), UB(1) - call AD_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) - do i1 = LB(1), UB(1) - call AD_PackOtherState(RF, InData%OtherSt(i1)) - end do - call AD_PackParam(RF, InData%p) - call AD_PackInput(RF, InData%u) - call AD_PackOutput(RF, InData%y) - call AD_PackMisc(RF, InData%m) - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call AD_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call AD_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) - call AD_PackOutput(RF, InData%Output(i1)) + call AD_PackConstrState(RF, InData%z(i1)) end do end if - call AD_PackOutput(RF, InData%y_interp) + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call AD_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if + call AD_PackParam(RF, InData%p) + call AD_PackOutput(RF, InData%y) + call AD_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) @@ -8844,17 +5023,7 @@ subroutine FAST_PackAeroDyn_Data(RF, Indata) call AD_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) - LB(1:1) = lbound(InData%Input_Saved) - UB(1:1) = ubound(InData%Input_Saved) - do i1 = LB(1), UB(1) - call AD_PackInput(RF, InData%Input_Saved(i1)) - end do - end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -8867,72 +5036,75 @@ subroutine FAST_UnPackAeroDyn_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) - do i1 = LB(1), UB(1) - call AD_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) - do i1 = LB(1), UB(1) - call AD_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) - do i1 = LB(1), UB(1) - call AD_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) - do i1 = LB(1), UB(1) - call AD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do - call AD_UnpackParam(RF, OutData%p) ! p - call AD_UnpackInput(RF, OutData%u) ! u - call AD_UnpackOutput(RF, OutData%y) ! y - call AD_UnpackMisc(RF, OutData%m) ! m - if (allocated(OutData%Output)) deallocate(OutData%Output) + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) + allocate(OutData%xd(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackOutput(RF, OutData%Output(i1)) ! Output + call AD_UnpackDiscState(RF, OutData%xd(i1)) ! xd end do end if - call AD_UnpackOutput(RF, OutData%y_interp) ! y_interp - if (allocated(OutData%Input)) deallocate(OutData%Input) + if (allocated(OutData%z)) deallocate(OutData%z) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input(LB(1):UB(1)),stat=stat) + allocate(OutData%z(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackInput(RF, OutData%Input(i1)) ! Input + call AD_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call AD_UnpackParam(RF, OutData%p) ! p + call AD_UnpackOutput(RF, OutData%y) ! y + call AD_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + call AD_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyExtLoads_Data(SrcExtLoads_DataData, DstExtLoads_DataData, CtrlCode, ErrStat, ErrMsg) @@ -9132,65 +5304,79 @@ subroutine FAST_CopyAeroDisk_Data(SrcAeroDisk_DataData, DstAeroDisk_DataData, Ct integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyAeroDisk_Data' - ErrStat = ErrID_None - ErrMsg = '' - LB(1:1) = lbound(SrcAeroDisk_DataData%x) - UB(1:1) = ubound(SrcAeroDisk_DataData%x) - do i1 = LB(1), UB(1) - call ADsk_CopyContState(SrcAeroDisk_DataData%x(i1), DstAeroDisk_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcAeroDisk_DataData%xd) - UB(1:1) = ubound(SrcAeroDisk_DataData%xd) - do i1 = LB(1), UB(1) - call ADsk_CopyDiscState(SrcAeroDisk_DataData%xd(i1), DstAeroDisk_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcAeroDisk_DataData%z) - UB(1:1) = ubound(SrcAeroDisk_DataData%z) - do i1 = LB(1), UB(1) - call ADsk_CopyConstrState(SrcAeroDisk_DataData%z(i1), DstAeroDisk_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcAeroDisk_DataData%OtherSt) - UB(1:1) = ubound(SrcAeroDisk_DataData%OtherSt) - do i1 = LB(1), UB(1) - call ADsk_CopyOtherState(SrcAeroDisk_DataData%OtherSt(i1), DstAeroDisk_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - call ADsk_CopyParam(SrcAeroDisk_DataData%p, DstAeroDisk_DataData%p, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call ADsk_CopyInput(SrcAeroDisk_DataData%u, DstAeroDisk_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call ADsk_CopyOutput(SrcAeroDisk_DataData%y, DstAeroDisk_DataData%y, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call ADsk_CopyMisc(SrcAeroDisk_DataData%m, DstAeroDisk_DataData%m, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcAeroDisk_DataData%Output)) then - LB(1:1) = lbound(SrcAeroDisk_DataData%Output) - UB(1:1) = ubound(SrcAeroDisk_DataData%Output) - if (.not. allocated(DstAeroDisk_DataData%Output)) then - allocate(DstAeroDisk_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcAeroDisk_DataData%x)) then + LB(1:1) = lbound(SrcAeroDisk_DataData%x) + UB(1:1) = ubound(SrcAeroDisk_DataData%x) + if (.not. allocated(DstAeroDisk_DataData%x)) then + allocate(DstAeroDisk_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDisk_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADsk_CopyContState(SrcAeroDisk_DataData%x(i1), DstAeroDisk_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcAeroDisk_DataData%xd)) then + LB(1:1) = lbound(SrcAeroDisk_DataData%xd) + UB(1:1) = ubound(SrcAeroDisk_DataData%xd) + if (.not. allocated(DstAeroDisk_DataData%xd)) then + allocate(DstAeroDisk_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDisk_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADsk_CopyDiscState(SrcAeroDisk_DataData%xd(i1), DstAeroDisk_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcAeroDisk_DataData%z)) then + LB(1:1) = lbound(SrcAeroDisk_DataData%z) + UB(1:1) = ubound(SrcAeroDisk_DataData%z) + if (.not. allocated(DstAeroDisk_DataData%z)) then + allocate(DstAeroDisk_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDisk_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADsk_CopyConstrState(SrcAeroDisk_DataData%z(i1), DstAeroDisk_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcAeroDisk_DataData%OtherSt)) then + LB(1:1) = lbound(SrcAeroDisk_DataData%OtherSt) + UB(1:1) = ubound(SrcAeroDisk_DataData%OtherSt) + if (.not. allocated(DstAeroDisk_DataData%OtherSt)) then + allocate(DstAeroDisk_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDisk_DataData%Output.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDisk_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call ADsk_CopyOutput(SrcAeroDisk_DataData%Output(i1), DstAeroDisk_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call ADsk_CopyOtherState(SrcAeroDisk_DataData%OtherSt(i1), DstAeroDisk_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - call ADsk_CopyOutput(SrcAeroDisk_DataData%y_interp, DstAeroDisk_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call ADsk_CopyParam(SrcAeroDisk_DataData%p, DstAeroDisk_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADsk_CopyOutput(SrcAeroDisk_DataData%y, DstAeroDisk_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADsk_CopyMisc(SrcAeroDisk_DataData%m, DstAeroDisk_DataData%m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcAeroDisk_DataData%Input)) then @@ -9234,49 +5420,48 @@ subroutine FAST_DestroyAeroDisk_Data(AeroDisk_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyAeroDisk_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(AeroDisk_DataData%x) - UB(1:1) = ubound(AeroDisk_DataData%x) - do i1 = LB(1), UB(1) - call ADsk_DestroyContState(AeroDisk_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(AeroDisk_DataData%xd) - UB(1:1) = ubound(AeroDisk_DataData%xd) - do i1 = LB(1), UB(1) - call ADsk_DestroyDiscState(AeroDisk_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(AeroDisk_DataData%z) - UB(1:1) = ubound(AeroDisk_DataData%z) - do i1 = LB(1), UB(1) - call ADsk_DestroyConstrState(AeroDisk_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(AeroDisk_DataData%OtherSt) - UB(1:1) = ubound(AeroDisk_DataData%OtherSt) - do i1 = LB(1), UB(1) - call ADsk_DestroyOtherState(AeroDisk_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(AeroDisk_DataData%x)) then + LB(1:1) = lbound(AeroDisk_DataData%x) + UB(1:1) = ubound(AeroDisk_DataData%x) + do i1 = LB(1), UB(1) + call ADsk_DestroyContState(AeroDisk_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDisk_DataData%x) + end if + if (allocated(AeroDisk_DataData%xd)) then + LB(1:1) = lbound(AeroDisk_DataData%xd) + UB(1:1) = ubound(AeroDisk_DataData%xd) + do i1 = LB(1), UB(1) + call ADsk_DestroyDiscState(AeroDisk_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDisk_DataData%xd) + end if + if (allocated(AeroDisk_DataData%z)) then + LB(1:1) = lbound(AeroDisk_DataData%z) + UB(1:1) = ubound(AeroDisk_DataData%z) + do i1 = LB(1), UB(1) + call ADsk_DestroyConstrState(AeroDisk_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDisk_DataData%z) + end if + if (allocated(AeroDisk_DataData%OtherSt)) then + LB(1:1) = lbound(AeroDisk_DataData%OtherSt) + UB(1:1) = ubound(AeroDisk_DataData%OtherSt) + do i1 = LB(1), UB(1) + call ADsk_DestroyOtherState(AeroDisk_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDisk_DataData%OtherSt) + end if call ADsk_DestroyParam(AeroDisk_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ADsk_DestroyInput(AeroDisk_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call ADsk_DestroyOutput(AeroDisk_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call ADsk_DestroyMisc(AeroDisk_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(AeroDisk_DataData%Output)) then - LB(1:1) = lbound(AeroDisk_DataData%Output) - UB(1:1) = ubound(AeroDisk_DataData%Output) - do i1 = LB(1), UB(1) - call ADsk_DestroyOutput(AeroDisk_DataData%Output(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(AeroDisk_DataData%Output) - end if - call ADsk_DestroyOutput(AeroDisk_DataData%y_interp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(AeroDisk_DataData%Input)) then LB(1:1) = lbound(AeroDisk_DataData%Input) UB(1:1) = ubound(AeroDisk_DataData%Input) @@ -9298,40 +5483,45 @@ subroutine FAST_PackAeroDisk_Data(RF, Indata) integer(B4Ki) :: i1 integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) - do i1 = LB(1), UB(1) - call ADsk_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) - do i1 = LB(1), UB(1) - call ADsk_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) - do i1 = LB(1), UB(1) - call ADsk_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) - do i1 = LB(1), UB(1) - call ADsk_PackOtherState(RF, InData%OtherSt(i1)) - end do - call ADsk_PackParam(RF, InData%p) - call ADsk_PackInput(RF, InData%u) - call ADsk_PackOutput(RF, InData%y) - call ADsk_PackMisc(RF, InData%m) - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call ADsk_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) - call ADsk_PackOutput(RF, InData%Output(i1)) + call ADsk_PackDiscState(RF, InData%xd(i1)) end do end if - call ADsk_PackOutput(RF, InData%y_interp) + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call ADsk_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call ADsk_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if + call ADsk_PackParam(RF, InData%p) + call ADsk_PackOutput(RF, InData%y) + call ADsk_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) @@ -9354,44 +5544,61 @@ subroutine FAST_UnPackAeroDisk_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) - do i1 = LB(1), UB(1) - call ADsk_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) - do i1 = LB(1), UB(1) - call ADsk_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) - do i1 = LB(1), UB(1) - call ADsk_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) - do i1 = LB(1), UB(1) - call ADsk_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do - call ADsk_UnpackParam(RF, OutData%p) ! p - call ADsk_UnpackInput(RF, OutData%u) ! u - call ADsk_UnpackOutput(RF, OutData%y) ! y - call ADsk_UnpackMisc(RF, OutData%m) ! m - if (allocated(OutData%Output)) deallocate(OutData%Output) + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADsk_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADsk_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADsk_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ADsk_UnpackOutput(RF, OutData%Output(i1)) ! Output + call ADsk_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do end if - call ADsk_UnpackOutput(RF, OutData%y_interp) ! y_interp + call ADsk_UnpackParam(RF, OutData%p) ! p + call ADsk_UnpackOutput(RF, OutData%y) ! y + call ADsk_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -9421,93 +5628,91 @@ subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataDa character(*), parameter :: RoutineName = 'FAST_CopyInflowWind_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcInflowWind_DataData%x) - UB(1:1) = ubound(SrcInflowWind_DataData%x) - do i1 = LB(1), UB(1) - call InflowWind_CopyContState(SrcInflowWind_DataData%x(i1), DstInflowWind_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcInflowWind_DataData%xd) - UB(1:1) = ubound(SrcInflowWind_DataData%xd) - do i1 = LB(1), UB(1) - call InflowWind_CopyDiscState(SrcInflowWind_DataData%xd(i1), DstInflowWind_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcInflowWind_DataData%z) - UB(1:1) = ubound(SrcInflowWind_DataData%z) - do i1 = LB(1), UB(1) - call InflowWind_CopyConstrState(SrcInflowWind_DataData%z(i1), DstInflowWind_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcInflowWind_DataData%OtherSt) - UB(1:1) = ubound(SrcInflowWind_DataData%OtherSt) - do i1 = LB(1), UB(1) - call InflowWind_CopyOtherState(SrcInflowWind_DataData%OtherSt(i1), DstInflowWind_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - call InflowWind_CopyParam(SrcInflowWind_DataData%p, DstInflowWind_DataData%p, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call InflowWind_CopyInput(SrcInflowWind_DataData%u, DstInflowWind_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call InflowWind_CopyOutput(SrcInflowWind_DataData%y, DstInflowWind_DataData%y, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call InflowWind_CopyMisc(SrcInflowWind_DataData%m, DstInflowWind_DataData%m, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcInflowWind_DataData%Output)) then - LB(1:1) = lbound(SrcInflowWind_DataData%Output) - UB(1:1) = ubound(SrcInflowWind_DataData%Output) - if (.not. allocated(DstInflowWind_DataData%Output)) then - allocate(DstInflowWind_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInflowWind_DataData%x)) then + LB(1:1) = lbound(SrcInflowWind_DataData%x) + UB(1:1) = ubound(SrcInflowWind_DataData%x) + if (.not. allocated(DstInflowWind_DataData%x)) then + allocate(DstInflowWind_DataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Output.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%x.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call InflowWind_CopyOutput(SrcInflowWind_DataData%Output(i1), DstInflowWind_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call InflowWind_CopyContState(SrcInflowWind_DataData%x(i1), DstInflowWind_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - call InflowWind_CopyOutput(SrcInflowWind_DataData%y_interp, DstInflowWind_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcInflowWind_DataData%Input)) then - LB(1:1) = lbound(SrcInflowWind_DataData%Input) - UB(1:1) = ubound(SrcInflowWind_DataData%Input) - if (.not. allocated(DstInflowWind_DataData%Input)) then - allocate(DstInflowWind_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInflowWind_DataData%xd)) then + LB(1:1) = lbound(SrcInflowWind_DataData%xd) + UB(1:1) = ubound(SrcInflowWind_DataData%xd) + if (.not. allocated(DstInflowWind_DataData%xd)) then + allocate(DstInflowWind_DataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Input.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%xd.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call InflowWind_CopyInput(SrcInflowWind_DataData%Input(i1), DstInflowWind_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call InflowWind_CopyDiscState(SrcInflowWind_DataData%xd(i1), DstInflowWind_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInflowWind_DataData%z)) then + LB(1:1) = lbound(SrcInflowWind_DataData%z) + UB(1:1) = ubound(SrcInflowWind_DataData%z) + if (.not. allocated(DstInflowWind_DataData%z)) then + allocate(DstInflowWind_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyConstrState(SrcInflowWind_DataData%z(i1), DstInflowWind_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInflowWind_DataData%OtherSt)) then + LB(1:1) = lbound(SrcInflowWind_DataData%OtherSt) + UB(1:1) = ubound(SrcInflowWind_DataData%OtherSt) + if (.not. allocated(DstInflowWind_DataData%OtherSt)) then + allocate(DstInflowWind_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyOtherState(SrcInflowWind_DataData%OtherSt(i1), DstInflowWind_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcInflowWind_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcInflowWind_DataData%Input_Saved) - UB(1:1) = ubound(SrcInflowWind_DataData%Input_Saved) - if (.not. allocated(DstInflowWind_DataData%Input_Saved)) then - allocate(DstInflowWind_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + 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_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 + LB(1:1) = lbound(SrcInflowWind_DataData%Input) + UB(1:1) = ubound(SrcInflowWind_DataData%Input) + if (.not. allocated(DstInflowWind_DataData%Input)) then + allocate(DstInflowWind_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Input.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call InflowWind_CopyInput(SrcInflowWind_DataData%Input_Saved(i1), DstInflowWind_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + call InflowWind_CopyInput(SrcInflowWind_DataData%Input(i1), DstInflowWind_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do @@ -9524,18 +5729,6 @@ subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataDa end if DstInflowWind_DataData%InputTimes = SrcInflowWind_DataData%InputTimes end if - if (allocated(SrcInflowWind_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcInflowWind_DataData%InputTimes_Saved) - UB(1:1) = ubound(SrcInflowWind_DataData%InputTimes_Saved) - if (.not. allocated(DstInflowWind_DataData%InputTimes_Saved)) then - allocate(DstInflowWind_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInflowWind_DataData%InputTimes_Saved = SrcInflowWind_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) @@ -9549,49 +5742,48 @@ subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyInflowWind_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(InflowWind_DataData%x) - UB(1:1) = ubound(InflowWind_DataData%x) - do i1 = LB(1), UB(1) - call InflowWind_DestroyContState(InflowWind_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(InflowWind_DataData%xd) - UB(1:1) = ubound(InflowWind_DataData%xd) - do i1 = LB(1), UB(1) - call InflowWind_DestroyDiscState(InflowWind_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(InflowWind_DataData%z) - UB(1:1) = ubound(InflowWind_DataData%z) - do i1 = LB(1), UB(1) - call InflowWind_DestroyConstrState(InflowWind_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(InflowWind_DataData%OtherSt) - UB(1:1) = ubound(InflowWind_DataData%OtherSt) - do i1 = LB(1), UB(1) - call InflowWind_DestroyOtherState(InflowWind_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(InflowWind_DataData%x)) then + LB(1:1) = lbound(InflowWind_DataData%x) + UB(1:1) = ubound(InflowWind_DataData%x) + do i1 = LB(1), UB(1) + call InflowWind_DestroyContState(InflowWind_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InflowWind_DataData%x) + end if + if (allocated(InflowWind_DataData%xd)) then + LB(1:1) = lbound(InflowWind_DataData%xd) + UB(1:1) = ubound(InflowWind_DataData%xd) + do i1 = LB(1), UB(1) + call InflowWind_DestroyDiscState(InflowWind_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InflowWind_DataData%xd) + end if + if (allocated(InflowWind_DataData%z)) then + LB(1:1) = lbound(InflowWind_DataData%z) + UB(1:1) = ubound(InflowWind_DataData%z) + do i1 = LB(1), UB(1) + call InflowWind_DestroyConstrState(InflowWind_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InflowWind_DataData%z) + end if + if (allocated(InflowWind_DataData%OtherSt)) then + LB(1:1) = lbound(InflowWind_DataData%OtherSt) + UB(1:1) = ubound(InflowWind_DataData%OtherSt) + do i1 = LB(1), UB(1) + call InflowWind_DestroyOtherState(InflowWind_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InflowWind_DataData%OtherSt) + end if call InflowWind_DestroyParam(InflowWind_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call InflowWind_DestroyInput(InflowWind_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call InflowWind_DestroyOutput(InflowWind_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call InflowWind_DestroyMisc(InflowWind_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(InflowWind_DataData%Output)) then - LB(1:1) = lbound(InflowWind_DataData%Output) - UB(1:1) = ubound(InflowWind_DataData%Output) - do i1 = LB(1), UB(1) - call InflowWind_DestroyOutput(InflowWind_DataData%Output(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(InflowWind_DataData%Output) - end if - call InflowWind_DestroyOutput(InflowWind_DataData%y_interp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InflowWind_DataData%Input)) then LB(1:1) = lbound(InflowWind_DataData%Input) UB(1:1) = ubound(InflowWind_DataData%Input) @@ -9601,21 +5793,9 @@ subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) end do deallocate(InflowWind_DataData%Input) end if - if (allocated(InflowWind_DataData%Input_Saved)) then - LB(1:1) = lbound(InflowWind_DataData%Input_Saved) - UB(1:1) = ubound(InflowWind_DataData%Input_Saved) - do i1 = LB(1), UB(1) - call InflowWind_DestroyInput(InflowWind_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(InflowWind_DataData%Input_Saved) - end if if (allocated(InflowWind_DataData%InputTimes)) then deallocate(InflowWind_DataData%InputTimes) end if - if (allocated(InflowWind_DataData%InputTimes_Saved)) then - deallocate(InflowWind_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackInflowWind_Data(RF, Indata) @@ -9625,40 +5805,45 @@ subroutine FAST_PackInflowWind_Data(RF, Indata) integer(B4Ki) :: i1 integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) - do i1 = LB(1), UB(1) - call InflowWind_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) - do i1 = LB(1), UB(1) - call InflowWind_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) - do i1 = LB(1), UB(1) - call InflowWind_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) - do i1 = LB(1), UB(1) - call InflowWind_PackOtherState(RF, InData%OtherSt(i1)) - end do - call InflowWind_PackParam(RF, InData%p) - call InflowWind_PackInput(RF, InData%u) - call InflowWind_PackOutput(RF, InData%y) - call InflowWind_PackMisc(RF, InData%m) - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call InflowWind_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call InflowWind_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call InflowWind_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) - call InflowWind_PackOutput(RF, InData%Output(i1)) + call InflowWind_PackOtherState(RF, InData%OtherSt(i1)) end do end if - call InflowWind_PackOutput(RF, InData%y_interp) + call InflowWind_PackParam(RF, InData%p) + call InflowWind_PackOutput(RF, InData%y) + call InflowWind_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) @@ -9668,17 +5853,7 @@ subroutine FAST_PackInflowWind_Data(RF, Indata) call InflowWind_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) - LB(1:1) = lbound(InData%Input_Saved) - UB(1:1) = ubound(InData%Input_Saved) - do i1 = LB(1), UB(1) - call InflowWind_PackInput(RF, InData%Input_Saved(i1)) - end do - end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -9691,72 +5866,75 @@ subroutine FAST_UnPackInflowWind_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) - do i1 = LB(1), UB(1) - call InflowWind_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) - do i1 = LB(1), UB(1) - call InflowWind_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) - do i1 = LB(1), UB(1) - call InflowWind_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) - do i1 = LB(1), UB(1) - call InflowWind_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do - call InflowWind_UnpackParam(RF, OutData%p) ! p - call InflowWind_UnpackInput(RF, OutData%u) ! u - call InflowWind_UnpackOutput(RF, OutData%y) ! y - call InflowWind_UnpackMisc(RF, OutData%m) ! m - if (allocated(OutData%Output)) deallocate(OutData%Output) + if (allocated(OutData%x)) deallocate(OutData%x) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) + allocate(OutData%x(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call InflowWind_UnpackOutput(RF, OutData%Output(i1)) ! Output + call InflowWind_UnpackContState(RF, OutData%x(i1)) ! x end do end if - call InflowWind_UnpackOutput(RF, OutData%y_interp) ! y_interp - if (allocated(OutData%Input)) deallocate(OutData%Input) + if (allocated(OutData%xd)) deallocate(OutData%xd) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input(LB(1):UB(1)),stat=stat) + allocate(OutData%xd(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call InflowWind_UnpackInput(RF, OutData%Input(i1)) ! Input + call InflowWind_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call InflowWind_UnpackParam(RF, OutData%p) ! p + call InflowWind_UnpackOutput(RF, OutData%y) ! y + call InflowWind_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call InflowWind_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + call InflowWind_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyExternalInflow_Data(SrcExternalInflow_DataData, DstExternalInflow_DataData, CtrlCode, ErrStat, ErrMsg) @@ -9899,97 +6077,98 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode character(*), parameter :: RoutineName = 'FAST_CopySubDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcSubDyn_DataData%x) - UB(1:1) = ubound(SrcSubDyn_DataData%x) - do i1 = LB(1), UB(1) - call SD_CopyContState(SrcSubDyn_DataData%x(i1), DstSubDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcSubDyn_DataData%xd) - UB(1:1) = ubound(SrcSubDyn_DataData%xd) - do i1 = LB(1), UB(1) - call SD_CopyDiscState(SrcSubDyn_DataData%xd(i1), DstSubDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcSubDyn_DataData%z) - UB(1:1) = ubound(SrcSubDyn_DataData%z) - do i1 = LB(1), UB(1) - call SD_CopyConstrState(SrcSubDyn_DataData%z(i1), DstSubDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcSubDyn_DataData%OtherSt) - UB(1:1) = ubound(SrcSubDyn_DataData%OtherSt) - do i1 = LB(1), UB(1) - call SD_CopyOtherState(SrcSubDyn_DataData%OtherSt(i1), DstSubDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - call SD_CopyParam(SrcSubDyn_DataData%p, DstSubDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SD_CopyInput(SrcSubDyn_DataData%u, DstSubDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SD_CopyOutput(SrcSubDyn_DataData%y, DstSubDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SD_CopyMisc(SrcSubDyn_DataData%m, DstSubDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + if (allocated(SrcSubDyn_DataData%x)) then + LB(1:1) = lbound(SrcSubDyn_DataData%x) + UB(1:1) = ubound(SrcSubDyn_DataData%x) + if (.not. allocated(DstSubDyn_DataData%x)) then + allocate(DstSubDyn_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyContState(SrcSubDyn_DataData%x(i1), DstSubDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call SD_CopyContState(SrcSubDyn_DataData%dxdt, DstSubDyn_DataData%dxdt, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - if (allocated(SrcSubDyn_DataData%Input)) then - LB(1:1) = lbound(SrcSubDyn_DataData%Input) - UB(1:1) = ubound(SrcSubDyn_DataData%Input) - if (.not. allocated(DstSubDyn_DataData%Input)) then - allocate(DstSubDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcSubDyn_DataData%xd)) then + LB(1:1) = lbound(SrcSubDyn_DataData%xd) + UB(1:1) = ubound(SrcSubDyn_DataData%xd) + if (.not. allocated(DstSubDyn_DataData%xd)) then + allocate(DstSubDyn_DataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%xd.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call SD_CopyInput(SrcSubDyn_DataData%Input(i1), DstSubDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SD_CopyDiscState(SrcSubDyn_DataData%xd(i1), DstSubDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcSubDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcSubDyn_DataData%Input_Saved) - UB(1:1) = ubound(SrcSubDyn_DataData%Input_Saved) - if (.not. allocated(DstSubDyn_DataData%Input_Saved)) then - allocate(DstSubDyn_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcSubDyn_DataData%z)) then + LB(1:1) = lbound(SrcSubDyn_DataData%z) + UB(1:1) = ubound(SrcSubDyn_DataData%z) + if (.not. allocated(DstSubDyn_DataData%z)) then + allocate(DstSubDyn_DataData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%z.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call SD_CopyInput(SrcSubDyn_DataData%Input_Saved(i1), DstSubDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + call SD_CopyConstrState(SrcSubDyn_DataData%z(i1), DstSubDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcSubDyn_DataData%Output)) then - LB(1:1) = lbound(SrcSubDyn_DataData%Output) - UB(1:1) = ubound(SrcSubDyn_DataData%Output) - if (.not. allocated(DstSubDyn_DataData%Output)) then - allocate(DstSubDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcSubDyn_DataData%OtherSt)) then + LB(1:1) = lbound(SrcSubDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcSubDyn_DataData%OtherSt) + if (.not. allocated(DstSubDyn_DataData%OtherSt)) then + allocate(DstSubDyn_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call SD_CopyOutput(SrcSubDyn_DataData%Output(i1), DstSubDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SD_CopyOtherState(SrcSubDyn_DataData%OtherSt(i1), DstSubDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - call SD_CopyOutput(SrcSubDyn_DataData%y_interp, DstSubDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + 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_CopyOutput(SrcSubDyn_DataData%y, DstSubDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyMisc(SrcSubDyn_DataData%m, DstSubDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + if (allocated(SrcSubDyn_DataData%Input)) then + LB(1:1) = lbound(SrcSubDyn_DataData%Input) + UB(1:1) = ubound(SrcSubDyn_DataData%Input) + if (.not. allocated(DstSubDyn_DataData%Input)) then + allocate(DstSubDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyInput(SrcSubDyn_DataData%Input(i1), DstSubDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if if (allocated(SrcSubDyn_DataData%InputTimes)) then LB(1:1) = lbound(SrcSubDyn_DataData%InputTimes) UB(1:1) = ubound(SrcSubDyn_DataData%InputTimes) @@ -10002,18 +6181,6 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode end if DstSubDyn_DataData%InputTimes = SrcSubDyn_DataData%InputTimes end if - if (allocated(SrcSubDyn_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcSubDyn_DataData%InputTimes_Saved) - UB(1:1) = ubound(SrcSubDyn_DataData%InputTimes_Saved) - if (.not. allocated(DstSubDyn_DataData%InputTimes_Saved)) then - allocate(DstSubDyn_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstSubDyn_DataData%InputTimes_Saved = SrcSubDyn_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) @@ -10027,33 +6194,45 @@ subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroySubDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SubDyn_DataData%x) - UB(1:1) = ubound(SubDyn_DataData%x) - do i1 = LB(1), UB(1) - call SD_DestroyContState(SubDyn_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(SubDyn_DataData%xd) - UB(1:1) = ubound(SubDyn_DataData%xd) - do i1 = LB(1), UB(1) - call SD_DestroyDiscState(SubDyn_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(SubDyn_DataData%z) - UB(1:1) = ubound(SubDyn_DataData%z) - do i1 = LB(1), UB(1) - call SD_DestroyConstrState(SubDyn_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(SubDyn_DataData%OtherSt) - UB(1:1) = ubound(SubDyn_DataData%OtherSt) - do i1 = LB(1), UB(1) - call SD_DestroyOtherState(SubDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - call SD_DestroyParam(SubDyn_DataData%p, ErrStat2, ErrMsg2) + if (allocated(SubDyn_DataData%x)) then + LB(1:1) = lbound(SubDyn_DataData%x) + UB(1:1) = ubound(SubDyn_DataData%x) + do i1 = LB(1), UB(1) + call SD_DestroyContState(SubDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SubDyn_DataData%x) + end if + call SD_DestroyContState(SubDyn_DataData%dxdt, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SD_DestroyInput(SubDyn_DataData%u, ErrStat2, ErrMsg2) + if (allocated(SubDyn_DataData%xd)) then + LB(1:1) = lbound(SubDyn_DataData%xd) + UB(1:1) = ubound(SubDyn_DataData%xd) + do i1 = LB(1), UB(1) + call SD_DestroyDiscState(SubDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SubDyn_DataData%xd) + end if + if (allocated(SubDyn_DataData%z)) then + LB(1:1) = lbound(SubDyn_DataData%z) + UB(1:1) = ubound(SubDyn_DataData%z) + do i1 = LB(1), UB(1) + call SD_DestroyConstrState(SubDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SubDyn_DataData%z) + end if + if (allocated(SubDyn_DataData%OtherSt)) then + LB(1:1) = lbound(SubDyn_DataData%OtherSt) + UB(1:1) = ubound(SubDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call SD_DestroyOtherState(SubDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SubDyn_DataData%OtherSt) + end if + call SD_DestroyParam(SubDyn_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SD_DestroyOutput(SubDyn_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10068,32 +6247,9 @@ subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) end do deallocate(SubDyn_DataData%Input) end if - if (allocated(SubDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(SubDyn_DataData%Input_Saved) - UB(1:1) = ubound(SubDyn_DataData%Input_Saved) - do i1 = LB(1), UB(1) - call SD_DestroyInput(SubDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(SubDyn_DataData%Input_Saved) - end if - if (allocated(SubDyn_DataData%Output)) then - LB(1:1) = lbound(SubDyn_DataData%Output) - UB(1:1) = ubound(SubDyn_DataData%Output) - do i1 = LB(1), UB(1) - call SD_DestroyOutput(SubDyn_DataData%Output(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(SubDyn_DataData%Output) - end if - call SD_DestroyOutput(SubDyn_DataData%y_interp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(SubDyn_DataData%InputTimes)) then deallocate(SubDyn_DataData%InputTimes) end if - if (allocated(SubDyn_DataData%InputTimes_Saved)) then - deallocate(SubDyn_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackSubDyn_Data(RF, Indata) @@ -10103,28 +6259,44 @@ subroutine FAST_PackSubDyn_Data(RF, Indata) integer(B4Ki) :: i1 integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) - do i1 = LB(1), UB(1) - call SD_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) - do i1 = LB(1), UB(1) - call SD_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) - do i1 = LB(1), UB(1) - call SD_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) - do i1 = LB(1), UB(1) - call SD_PackOtherState(RF, InData%OtherSt(i1)) - end do + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call SD_PackContState(RF, InData%x(i1)) + end do + end if + call SD_PackContState(RF, InData%dxdt) + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call SD_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call SD_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call SD_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if call SD_PackParam(RF, InData%p) - call SD_PackInput(RF, InData%u) call SD_PackOutput(RF, InData%y) call SD_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) @@ -10136,27 +6308,7 @@ subroutine FAST_PackSubDyn_Data(RF, Indata) call SD_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) - LB(1:1) = lbound(InData%Input_Saved) - UB(1:1) = ubound(InData%Input_Saved) - do i1 = LB(1), UB(1) - call SD_PackInput(RF, InData%Input_Saved(i1)) - end do - end if - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) - do i1 = LB(1), UB(1) - call SD_PackOutput(RF, InData%Output(i1)) - end do - end if - call SD_PackOutput(RF, InData%y_interp) call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -10169,72 +6321,76 @@ subroutine FAST_UnPackSubDyn_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) - do i1 = LB(1), UB(1) - call SD_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) - do i1 = LB(1), UB(1) - call SD_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) - do i1 = LB(1), UB(1) - call SD_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) - do i1 = LB(1), UB(1) - call SD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do - call SD_UnpackParam(RF, OutData%p) ! p - call SD_UnpackInput(RF, OutData%u) ! u - call SD_UnpackOutput(RF, OutData%y) ! y - call SD_UnpackMisc(RF, OutData%m) ! m - if (allocated(OutData%Input)) deallocate(OutData%Input) + if (allocated(OutData%x)) deallocate(OutData%x) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input(LB(1):UB(1)),stat=stat) + allocate(OutData%x(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SD_UnpackInput(RF, OutData%Input(i1)) ! Input + call SD_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + call SD_UnpackContState(RF, OutData%dxdt) ! dxdt + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackConstrState(RF, OutData%z(i1)) ! z end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SD_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + call SD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do end if - if (allocated(OutData%Output)) deallocate(OutData%Output) + call SD_UnpackParam(RF, OutData%p) ! p + call SD_UnpackOutput(RF, OutData%y) ! y + call SD_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) + allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SD_UnpackOutput(RF, OutData%Output(i1)) ! Output + call SD_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - call SD_UnpackOutput(RF, OutData%y_interp) ! y_interp call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlCode, ErrStat, ErrMsg) @@ -10250,40 +6406,73 @@ subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlC character(*), parameter :: RoutineName = 'FAST_CopyExtPtfm_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcExtPtfm_DataData%x) - UB(1:1) = ubound(SrcExtPtfm_DataData%x) - do i1 = LB(1), UB(1) - call ExtPtfm_CopyContState(SrcExtPtfm_DataData%x(i1), DstExtPtfm_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcExtPtfm_DataData%xd) - UB(1:1) = ubound(SrcExtPtfm_DataData%xd) - do i1 = LB(1), UB(1) - call ExtPtfm_CopyDiscState(SrcExtPtfm_DataData%xd(i1), DstExtPtfm_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcExtPtfm_DataData%z) - UB(1:1) = ubound(SrcExtPtfm_DataData%z) - do i1 = LB(1), UB(1) - call ExtPtfm_CopyConstrState(SrcExtPtfm_DataData%z(i1), DstExtPtfm_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcExtPtfm_DataData%OtherSt) - UB(1:1) = ubound(SrcExtPtfm_DataData%OtherSt) - do i1 = LB(1), UB(1) - call ExtPtfm_CopyOtherState(SrcExtPtfm_DataData%OtherSt(i1), DstExtPtfm_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + if (allocated(SrcExtPtfm_DataData%x)) then + LB(1:1) = lbound(SrcExtPtfm_DataData%x) + UB(1:1) = ubound(SrcExtPtfm_DataData%x) + if (.not. allocated(DstExtPtfm_DataData%x)) then + allocate(DstExtPtfm_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyContState(SrcExtPtfm_DataData%x(i1), DstExtPtfm_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcExtPtfm_DataData%xd)) then + LB(1:1) = lbound(SrcExtPtfm_DataData%xd) + UB(1:1) = ubound(SrcExtPtfm_DataData%xd) + if (.not. allocated(DstExtPtfm_DataData%xd)) then + allocate(DstExtPtfm_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyDiscState(SrcExtPtfm_DataData%xd(i1), DstExtPtfm_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcExtPtfm_DataData%z)) then + LB(1:1) = lbound(SrcExtPtfm_DataData%z) + UB(1:1) = ubound(SrcExtPtfm_DataData%z) + if (.not. allocated(DstExtPtfm_DataData%z)) then + allocate(DstExtPtfm_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyConstrState(SrcExtPtfm_DataData%z(i1), DstExtPtfm_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcExtPtfm_DataData%OtherSt)) then + LB(1:1) = lbound(SrcExtPtfm_DataData%OtherSt) + UB(1:1) = ubound(SrcExtPtfm_DataData%OtherSt) + if (.not. allocated(DstExtPtfm_DataData%OtherSt)) then + allocate(DstExtPtfm_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyOtherState(SrcExtPtfm_DataData%OtherSt(i1), DstExtPtfm_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if 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 @@ -10306,22 +6495,6 @@ subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlC if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcExtPtfm_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcExtPtfm_DataData%Input_Saved) - UB(1:1) = ubound(SrcExtPtfm_DataData%Input_Saved) - if (.not. allocated(DstExtPtfm_DataData%Input_Saved)) then - allocate(DstExtPtfm_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call ExtPtfm_CopyInput(SrcExtPtfm_DataData%Input_Saved(i1), DstExtPtfm_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcExtPtfm_DataData%InputTimes)) then LB(1:1) = lbound(SrcExtPtfm_DataData%InputTimes) UB(1:1) = ubound(SrcExtPtfm_DataData%InputTimes) @@ -10334,18 +6507,6 @@ subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlC end if DstExtPtfm_DataData%InputTimes = SrcExtPtfm_DataData%InputTimes end if - if (allocated(SrcExtPtfm_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcExtPtfm_DataData%InputTimes_Saved) - UB(1:1) = ubound(SrcExtPtfm_DataData%InputTimes_Saved) - if (.not. allocated(DstExtPtfm_DataData%InputTimes_Saved)) then - allocate(DstExtPtfm_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstExtPtfm_DataData%InputTimes_Saved = SrcExtPtfm_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyExtPtfm_Data(ExtPtfm_DataData, ErrStat, ErrMsg) @@ -10359,34 +6520,44 @@ subroutine FAST_DestroyExtPtfm_Data(ExtPtfm_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyExtPtfm_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(ExtPtfm_DataData%x) - UB(1:1) = ubound(ExtPtfm_DataData%x) - do i1 = LB(1), UB(1) - call ExtPtfm_DestroyContState(ExtPtfm_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(ExtPtfm_DataData%xd) - UB(1:1) = ubound(ExtPtfm_DataData%xd) - do i1 = LB(1), UB(1) - call ExtPtfm_DestroyDiscState(ExtPtfm_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(ExtPtfm_DataData%z) - UB(1:1) = ubound(ExtPtfm_DataData%z) - do i1 = LB(1), UB(1) - call ExtPtfm_DestroyConstrState(ExtPtfm_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(ExtPtfm_DataData%OtherSt) - UB(1:1) = ubound(ExtPtfm_DataData%OtherSt) - do i1 = LB(1), UB(1) - call ExtPtfm_DestroyOtherState(ExtPtfm_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(ExtPtfm_DataData%x)) then + LB(1:1) = lbound(ExtPtfm_DataData%x) + UB(1:1) = ubound(ExtPtfm_DataData%x) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyContState(ExtPtfm_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ExtPtfm_DataData%x) + end if + if (allocated(ExtPtfm_DataData%xd)) then + LB(1:1) = lbound(ExtPtfm_DataData%xd) + UB(1:1) = ubound(ExtPtfm_DataData%xd) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyDiscState(ExtPtfm_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ExtPtfm_DataData%xd) + end if + if (allocated(ExtPtfm_DataData%z)) then + LB(1:1) = lbound(ExtPtfm_DataData%z) + UB(1:1) = ubound(ExtPtfm_DataData%z) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyConstrState(ExtPtfm_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ExtPtfm_DataData%z) + end if + if (allocated(ExtPtfm_DataData%OtherSt)) then + LB(1:1) = lbound(ExtPtfm_DataData%OtherSt) + UB(1:1) = ubound(ExtPtfm_DataData%OtherSt) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyOtherState(ExtPtfm_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ExtPtfm_DataData%OtherSt) + end if call ExtPtfm_DestroyParam(ExtPtfm_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ExtPtfm_DestroyInput(ExtPtfm_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call ExtPtfm_DestroyOutput(ExtPtfm_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call ExtPtfm_DestroyMisc(ExtPtfm_DataData%m, ErrStat2, ErrMsg2) @@ -10400,21 +6571,9 @@ subroutine FAST_DestroyExtPtfm_Data(ExtPtfm_DataData, ErrStat, ErrMsg) end do deallocate(ExtPtfm_DataData%Input) end if - if (allocated(ExtPtfm_DataData%Input_Saved)) then - LB(1:1) = lbound(ExtPtfm_DataData%Input_Saved) - UB(1:1) = ubound(ExtPtfm_DataData%Input_Saved) - do i1 = LB(1), UB(1) - call ExtPtfm_DestroyInput(ExtPtfm_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ExtPtfm_DataData%Input_Saved) - end if if (allocated(ExtPtfm_DataData%InputTimes)) then deallocate(ExtPtfm_DataData%InputTimes) end if - if (allocated(ExtPtfm_DataData%InputTimes_Saved)) then - deallocate(ExtPtfm_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackExtPtfm_Data(RF, Indata) @@ -10424,28 +6583,43 @@ subroutine FAST_PackExtPtfm_Data(RF, Indata) integer(B4Ki) :: i1 integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) - do i1 = LB(1), UB(1) - call ExtPtfm_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) - do i1 = LB(1), UB(1) - call ExtPtfm_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) - do i1 = LB(1), UB(1) - call ExtPtfm_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) - do i1 = LB(1), UB(1) - call ExtPtfm_PackOtherState(RF, InData%OtherSt(i1)) - end do + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call ExtPtfm_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call ExtPtfm_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call ExtPtfm_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call ExtPtfm_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if call ExtPtfm_PackParam(RF, InData%p) - call ExtPtfm_PackInput(RF, InData%u) call ExtPtfm_PackOutput(RF, InData%y) call ExtPtfm_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) @@ -10454,54 +6628,75 @@ subroutine FAST_PackExtPtfm_Data(RF, Indata) LB(1:1) = lbound(InData%Input) UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) - call ExtPtfm_PackInput(RF, InData%Input(i1)) + call ExtPtfm_PackInput(RF, InData%Input(i1)) + end do + end if + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackExtPtfm_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackExtPtfm_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackConstrState(RF, OutData%z(i1)) ! z end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) - LB(1:1) = lbound(InData%Input_Saved) - UB(1:1) = ubound(InData%Input_Saved) + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if do i1 = LB(1), UB(1) - call ExtPtfm_PackInput(RF, InData%Input_Saved(i1)) + call ExtPtfm_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do end if - call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_UnPackExtPtfm_Data(RF, OutData) - type(RegFile), intent(inout) :: RF - type(ExtPtfm_Data), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackExtPtfm_Data' - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) - do i1 = LB(1), UB(1) - call ExtPtfm_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) - do i1 = LB(1), UB(1) - call ExtPtfm_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) - do i1 = LB(1), UB(1) - call ExtPtfm_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) - do i1 = LB(1), UB(1) - call ExtPtfm_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do call ExtPtfm_UnpackParam(RF, OutData%p) ! p - call ExtPtfm_UnpackInput(RF, OutData%u) ! u call ExtPtfm_UnpackOutput(RF, OutData%y) ! y call ExtPtfm_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Input)) deallocate(OutData%Input) @@ -10517,21 +6712,7 @@ subroutine FAST_UnPackExtPtfm_Data(RF, OutData) call ExtPtfm_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ExtPtfm_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved - end do - end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, CtrlCode, ErrStat, ErrMsg) @@ -10547,97 +6728,95 @@ subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, Ct character(*), parameter :: RoutineName = 'FAST_CopySeaState_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcSeaState_DataData%x) - UB(1:1) = ubound(SrcSeaState_DataData%x) - do i1 = LB(1), UB(1) - call SeaSt_CopyContState(SrcSeaState_DataData%x(i1), DstSeaState_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcSeaState_DataData%xd) - UB(1:1) = ubound(SrcSeaState_DataData%xd) - do i1 = LB(1), UB(1) - call SeaSt_CopyDiscState(SrcSeaState_DataData%xd(i1), DstSeaState_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcSeaState_DataData%z) - UB(1:1) = ubound(SrcSeaState_DataData%z) - do i1 = LB(1), UB(1) - call SeaSt_CopyConstrState(SrcSeaState_DataData%z(i1), DstSeaState_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcSeaState_DataData%OtherSt) - UB(1:1) = ubound(SrcSeaState_DataData%OtherSt) - do i1 = LB(1), UB(1) - call SeaSt_CopyOtherState(SrcSeaState_DataData%OtherSt(i1), DstSeaState_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - call SeaSt_CopyParam(SrcSeaState_DataData%p, DstSeaState_DataData%p, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SeaSt_CopyInput(SrcSeaState_DataData%u, DstSeaState_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SeaSt_CopyOutput(SrcSeaState_DataData%y, DstSeaState_DataData%y, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SeaSt_CopyMisc(SrcSeaState_DataData%m, DstSeaState_DataData%m, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcSeaState_DataData%Input)) then - LB(1:1) = lbound(SrcSeaState_DataData%Input) - UB(1:1) = ubound(SrcSeaState_DataData%Input) - if (.not. allocated(DstSeaState_DataData%Input)) then - allocate(DstSeaState_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcSeaState_DataData%x)) then + LB(1:1) = lbound(SrcSeaState_DataData%x) + UB(1:1) = ubound(SrcSeaState_DataData%x) + if (.not. allocated(DstSeaState_DataData%x)) then + allocate(DstSeaState_DataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Input.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%x.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call SeaSt_CopyInput(SrcSeaState_DataData%Input(i1), DstSeaState_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SeaSt_CopyContState(SrcSeaState_DataData%x(i1), DstSeaState_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcSeaState_DataData%xd)) then + LB(1:1) = lbound(SrcSeaState_DataData%xd) + UB(1:1) = ubound(SrcSeaState_DataData%xd) + if (.not. allocated(DstSeaState_DataData%xd)) then + allocate(DstSeaState_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_CopyDiscState(SrcSeaState_DataData%xd(i1), DstSeaState_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcSeaState_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcSeaState_DataData%Input_Saved) - UB(1:1) = ubound(SrcSeaState_DataData%Input_Saved) - if (.not. allocated(DstSeaState_DataData%Input_Saved)) then - allocate(DstSeaState_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcSeaState_DataData%z)) then + LB(1:1) = lbound(SrcSeaState_DataData%z) + UB(1:1) = ubound(SrcSeaState_DataData%z) + if (.not. allocated(DstSeaState_DataData%z)) then + allocate(DstSeaState_DataData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%z.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call SeaSt_CopyInput(SrcSeaState_DataData%Input_Saved(i1), DstSeaState_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + call SeaSt_CopyConstrState(SrcSeaState_DataData%z(i1), DstSeaState_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcSeaState_DataData%Output)) then - LB(1:1) = lbound(SrcSeaState_DataData%Output) - UB(1:1) = ubound(SrcSeaState_DataData%Output) - if (.not. allocated(DstSeaState_DataData%Output)) then - allocate(DstSeaState_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcSeaState_DataData%OtherSt)) then + LB(1:1) = lbound(SrcSeaState_DataData%OtherSt) + UB(1:1) = ubound(SrcSeaState_DataData%OtherSt) + if (.not. allocated(DstSeaState_DataData%OtherSt)) then + allocate(DstSeaState_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Output.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call SeaSt_CopyOutput(SrcSeaState_DataData%Output(i1), DstSeaState_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SeaSt_CopyOtherState(SrcSeaState_DataData%OtherSt(i1), DstSeaState_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - call SeaSt_CopyOutput(SrcSeaState_DataData%y_interp, DstSeaState_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SeaSt_CopyParam(SrcSeaState_DataData%p, DstSeaState_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyOutput(SrcSeaState_DataData%y, DstSeaState_DataData%y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + call SeaSt_CopyMisc(SrcSeaState_DataData%m, DstSeaState_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcSeaState_DataData%Input)) then + LB(1:1) = lbound(SrcSeaState_DataData%Input) + UB(1:1) = ubound(SrcSeaState_DataData%Input) + if (.not. allocated(DstSeaState_DataData%Input)) then + allocate(DstSeaState_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_CopyInput(SrcSeaState_DataData%Input(i1), DstSeaState_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if if (allocated(SrcSeaState_DataData%InputTimes)) then LB(1:1) = lbound(SrcSeaState_DataData%InputTimes) UB(1:1) = ubound(SrcSeaState_DataData%InputTimes) @@ -10650,18 +6829,6 @@ subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, Ct end if DstSeaState_DataData%InputTimes = SrcSeaState_DataData%InputTimes end if - if (allocated(SrcSeaState_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcSeaState_DataData%InputTimes_Saved) - UB(1:1) = ubound(SrcSeaState_DataData%InputTimes_Saved) - if (.not. allocated(DstSeaState_DataData%InputTimes_Saved)) then - allocate(DstSeaState_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstSeaState_DataData%InputTimes_Saved = SrcSeaState_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) @@ -10675,34 +6842,44 @@ subroutine FAST_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroySeaState_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SeaState_DataData%x) - UB(1:1) = ubound(SeaState_DataData%x) - do i1 = LB(1), UB(1) - call SeaSt_DestroyContState(SeaState_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(SeaState_DataData%xd) - UB(1:1) = ubound(SeaState_DataData%xd) - do i1 = LB(1), UB(1) - call SeaSt_DestroyDiscState(SeaState_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(SeaState_DataData%z) - UB(1:1) = ubound(SeaState_DataData%z) - do i1 = LB(1), UB(1) - call SeaSt_DestroyConstrState(SeaState_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(SeaState_DataData%OtherSt) - UB(1:1) = ubound(SeaState_DataData%OtherSt) - do i1 = LB(1), UB(1) - call SeaSt_DestroyOtherState(SeaState_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(SeaState_DataData%x)) then + LB(1:1) = lbound(SeaState_DataData%x) + UB(1:1) = ubound(SeaState_DataData%x) + do i1 = LB(1), UB(1) + call SeaSt_DestroyContState(SeaState_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SeaState_DataData%x) + end if + if (allocated(SeaState_DataData%xd)) then + LB(1:1) = lbound(SeaState_DataData%xd) + UB(1:1) = ubound(SeaState_DataData%xd) + do i1 = LB(1), UB(1) + call SeaSt_DestroyDiscState(SeaState_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SeaState_DataData%xd) + end if + if (allocated(SeaState_DataData%z)) then + LB(1:1) = lbound(SeaState_DataData%z) + UB(1:1) = ubound(SeaState_DataData%z) + do i1 = LB(1), UB(1) + call SeaSt_DestroyConstrState(SeaState_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SeaState_DataData%z) + end if + if (allocated(SeaState_DataData%OtherSt)) then + LB(1:1) = lbound(SeaState_DataData%OtherSt) + UB(1:1) = ubound(SeaState_DataData%OtherSt) + do i1 = LB(1), UB(1) + call SeaSt_DestroyOtherState(SeaState_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SeaState_DataData%OtherSt) + end if call SeaSt_DestroyParam(SeaState_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_DestroyInput(SeaState_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SeaSt_DestroyOutput(SeaState_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SeaSt_DestroyMisc(SeaState_DataData%m, ErrStat2, ErrMsg2) @@ -10716,32 +6893,9 @@ subroutine FAST_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) end do deallocate(SeaState_DataData%Input) end if - if (allocated(SeaState_DataData%Input_Saved)) then - LB(1:1) = lbound(SeaState_DataData%Input_Saved) - UB(1:1) = ubound(SeaState_DataData%Input_Saved) - do i1 = LB(1), UB(1) - call SeaSt_DestroyInput(SeaState_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(SeaState_DataData%Input_Saved) - end if - if (allocated(SeaState_DataData%Output)) then - LB(1:1) = lbound(SeaState_DataData%Output) - UB(1:1) = ubound(SeaState_DataData%Output) - do i1 = LB(1), UB(1) - call SeaSt_DestroyOutput(SeaState_DataData%Output(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(SeaState_DataData%Output) - end if - call SeaSt_DestroyOutput(SeaState_DataData%y_interp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(SeaState_DataData%InputTimes)) then deallocate(SeaState_DataData%InputTimes) end if - if (allocated(SeaState_DataData%InputTimes_Saved)) then - deallocate(SeaState_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackSeaState_Data(RF, Indata) @@ -10751,28 +6905,43 @@ subroutine FAST_PackSeaState_Data(RF, Indata) integer(B4Ki) :: i1 integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) - do i1 = LB(1), UB(1) - call SeaSt_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) - do i1 = LB(1), UB(1) - call SeaSt_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) - do i1 = LB(1), UB(1) - call SeaSt_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) - do i1 = LB(1), UB(1) - call SeaSt_PackOtherState(RF, InData%OtherSt(i1)) - end do + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call SeaSt_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call SeaSt_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call SeaSt_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call SeaSt_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if call SeaSt_PackParam(RF, InData%p) - call SeaSt_PackInput(RF, InData%u) call SeaSt_PackOutput(RF, InData%y) call SeaSt_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) @@ -10784,27 +6953,7 @@ subroutine FAST_PackSeaState_Data(RF, Indata) call SeaSt_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) - LB(1:1) = lbound(InData%Input_Saved) - UB(1:1) = ubound(InData%Input_Saved) - do i1 = LB(1), UB(1) - call SeaSt_PackInput(RF, InData%Input_Saved(i1)) - end do - end if - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) - do i1 = LB(1), UB(1) - call SeaSt_PackOutput(RF, InData%Output(i1)) - end do - end if - call SeaSt_PackOutput(RF, InData%y_interp) call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -10817,72 +6966,75 @@ subroutine FAST_UnPackSeaState_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) - do i1 = LB(1), UB(1) - call SeaSt_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) - do i1 = LB(1), UB(1) - call SeaSt_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) - do i1 = LB(1), UB(1) - call SeaSt_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) - do i1 = LB(1), UB(1) - call SeaSt_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do - call SeaSt_UnpackParam(RF, OutData%p) ! p - call SeaSt_UnpackInput(RF, OutData%u) ! u - call SeaSt_UnpackOutput(RF, OutData%y) ! y - call SeaSt_UnpackMisc(RF, OutData%m) ! m - if (allocated(OutData%Input)) deallocate(OutData%Input) + if (allocated(OutData%x)) deallocate(OutData%x) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input(LB(1):UB(1)),stat=stat) + allocate(OutData%x(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SeaSt_UnpackInput(RF, OutData%Input(i1)) ! Input + call SeaSt_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_UnpackConstrState(RF, OutData%z(i1)) ! z end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SeaSt_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + call SeaSt_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do end if - if (allocated(OutData%Output)) deallocate(OutData%Output) + call SeaSt_UnpackParam(RF, OutData%p) ! p + call SeaSt_UnpackOutput(RF, OutData%y) ! y + call SeaSt_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) + allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SeaSt_UnpackOutput(RF, OutData%Output(i1)) ! Output + call SeaSt_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - call SeaSt_UnpackOutput(RF, OutData%y_interp) ! y_interp call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, CtrlCode, ErrStat, ErrMsg) @@ -10898,93 +7050,94 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct character(*), parameter :: RoutineName = 'FAST_CopyHydroDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcHydroDyn_DataData%x) - UB(1:1) = ubound(SrcHydroDyn_DataData%x) - do i1 = LB(1), UB(1) - call HydroDyn_CopyContState(SrcHydroDyn_DataData%x(i1), DstHydroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcHydroDyn_DataData%xd) - UB(1:1) = ubound(SrcHydroDyn_DataData%xd) - do i1 = LB(1), UB(1) - call HydroDyn_CopyDiscState(SrcHydroDyn_DataData%xd(i1), DstHydroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcHydroDyn_DataData%z) - UB(1:1) = ubound(SrcHydroDyn_DataData%z) - do i1 = LB(1), UB(1) - call HydroDyn_CopyConstrState(SrcHydroDyn_DataData%z(i1), DstHydroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcHydroDyn_DataData%OtherSt) - UB(1:1) = ubound(SrcHydroDyn_DataData%OtherSt) - do i1 = LB(1), UB(1) - call HydroDyn_CopyOtherState(SrcHydroDyn_DataData%OtherSt(i1), DstHydroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - call HydroDyn_CopyParam(SrcHydroDyn_DataData%p, DstHydroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call HydroDyn_CopyInput(SrcHydroDyn_DataData%u, DstHydroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call HydroDyn_CopyOutput(SrcHydroDyn_DataData%y, DstHydroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call HydroDyn_CopyMisc(SrcHydroDyn_DataData%m, DstHydroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcHydroDyn_DataData%Output)) then - LB(1:1) = lbound(SrcHydroDyn_DataData%Output) - UB(1:1) = ubound(SrcHydroDyn_DataData%Output) - if (.not. allocated(DstHydroDyn_DataData%Output)) then - allocate(DstHydroDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcHydroDyn_DataData%x)) then + LB(1:1) = lbound(SrcHydroDyn_DataData%x) + UB(1:1) = ubound(SrcHydroDyn_DataData%x) + if (.not. allocated(DstHydroDyn_DataData%x)) then + allocate(DstHydroDyn_DataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%x.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call HydroDyn_CopyOutput(SrcHydroDyn_DataData%Output(i1), DstHydroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call HydroDyn_CopyContState(SrcHydroDyn_DataData%x(i1), DstHydroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - call HydroDyn_CopyOutput(SrcHydroDyn_DataData%y_interp, DstHydroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call HydroDyn_CopyContState(SrcHydroDyn_DataData%dxdt, DstHydroDyn_DataData%dxdt, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - if (allocated(SrcHydroDyn_DataData%Input)) then - LB(1:1) = lbound(SrcHydroDyn_DataData%Input) - UB(1:1) = ubound(SrcHydroDyn_DataData%Input) - if (.not. allocated(DstHydroDyn_DataData%Input)) then - allocate(DstHydroDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcHydroDyn_DataData%xd)) then + LB(1:1) = lbound(SrcHydroDyn_DataData%xd) + UB(1:1) = ubound(SrcHydroDyn_DataData%xd) + if (.not. allocated(DstHydroDyn_DataData%xd)) then + allocate(DstHydroDyn_DataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%xd.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call HydroDyn_CopyInput(SrcHydroDyn_DataData%Input(i1), DstHydroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call HydroDyn_CopyDiscState(SrcHydroDyn_DataData%xd(i1), DstHydroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcHydroDyn_DataData%z)) then + LB(1:1) = lbound(SrcHydroDyn_DataData%z) + UB(1:1) = ubound(SrcHydroDyn_DataData%z) + if (.not. allocated(DstHydroDyn_DataData%z)) then + allocate(DstHydroDyn_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyConstrState(SrcHydroDyn_DataData%z(i1), DstHydroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcHydroDyn_DataData%OtherSt)) then + LB(1:1) = lbound(SrcHydroDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcHydroDyn_DataData%OtherSt) + if (.not. allocated(DstHydroDyn_DataData%OtherSt)) then + allocate(DstHydroDyn_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyOtherState(SrcHydroDyn_DataData%OtherSt(i1), DstHydroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcHydroDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcHydroDyn_DataData%Input_Saved) - UB(1:1) = ubound(SrcHydroDyn_DataData%Input_Saved) - if (.not. allocated(DstHydroDyn_DataData%Input_Saved)) then - allocate(DstHydroDyn_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + 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_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%Input)) then + LB(1:1) = lbound(SrcHydroDyn_DataData%Input) + UB(1:1) = ubound(SrcHydroDyn_DataData%Input) + if (.not. allocated(DstHydroDyn_DataData%Input)) then + allocate(DstHydroDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call HydroDyn_CopyInput(SrcHydroDyn_DataData%Input_Saved(i1), DstHydroDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + call HydroDyn_CopyInput(SrcHydroDyn_DataData%Input(i1), DstHydroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do @@ -11001,18 +7154,6 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct end if DstHydroDyn_DataData%InputTimes = SrcHydroDyn_DataData%InputTimes end if - if (allocated(SrcHydroDyn_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcHydroDyn_DataData%InputTimes_Saved) - UB(1:1) = ubound(SrcHydroDyn_DataData%InputTimes_Saved) - if (.not. allocated(DstHydroDyn_DataData%InputTimes_Saved)) then - allocate(DstHydroDyn_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstHydroDyn_DataData%InputTimes_Saved = SrcHydroDyn_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) @@ -11026,48 +7167,49 @@ subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyHydroDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(HydroDyn_DataData%x) - UB(1:1) = ubound(HydroDyn_DataData%x) - do i1 = LB(1), UB(1) - call HydroDyn_DestroyContState(HydroDyn_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(HydroDyn_DataData%xd) - UB(1:1) = ubound(HydroDyn_DataData%xd) - do i1 = LB(1), UB(1) - call HydroDyn_DestroyDiscState(HydroDyn_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(HydroDyn_DataData%z) - UB(1:1) = ubound(HydroDyn_DataData%z) - do i1 = LB(1), UB(1) - call HydroDyn_DestroyConstrState(HydroDyn_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(HydroDyn_DataData%OtherSt) - UB(1:1) = ubound(HydroDyn_DataData%OtherSt) - do i1 = LB(1), UB(1) - call HydroDyn_DestroyOtherState(HydroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - call HydroDyn_DestroyParam(HydroDyn_DataData%p, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call HydroDyn_DestroyInput(HydroDyn_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call HydroDyn_DestroyOutput(HydroDyn_DataData%y, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call HydroDyn_DestroyMisc(HydroDyn_DataData%m, ErrStat2, ErrMsg2) + if (allocated(HydroDyn_DataData%x)) then + LB(1:1) = lbound(HydroDyn_DataData%x) + UB(1:1) = ubound(HydroDyn_DataData%x) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyContState(HydroDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(HydroDyn_DataData%x) + end if + call HydroDyn_DestroyContState(HydroDyn_DataData%dxdt, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(HydroDyn_DataData%Output)) then - LB(1:1) = lbound(HydroDyn_DataData%Output) - UB(1:1) = ubound(HydroDyn_DataData%Output) + if (allocated(HydroDyn_DataData%xd)) then + LB(1:1) = lbound(HydroDyn_DataData%xd) + UB(1:1) = ubound(HydroDyn_DataData%xd) do i1 = LB(1), UB(1) - call HydroDyn_DestroyOutput(HydroDyn_DataData%Output(i1), ErrStat2, ErrMsg2) + call HydroDyn_DestroyDiscState(HydroDyn_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(HydroDyn_DataData%Output) + deallocate(HydroDyn_DataData%xd) end if - call HydroDyn_DestroyOutput(HydroDyn_DataData%y_interp, ErrStat2, ErrMsg2) + if (allocated(HydroDyn_DataData%z)) then + LB(1:1) = lbound(HydroDyn_DataData%z) + UB(1:1) = ubound(HydroDyn_DataData%z) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyConstrState(HydroDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(HydroDyn_DataData%z) + end if + if (allocated(HydroDyn_DataData%OtherSt)) then + LB(1:1) = lbound(HydroDyn_DataData%OtherSt) + UB(1:1) = ubound(HydroDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyOtherState(HydroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(HydroDyn_DataData%OtherSt) + end if + call HydroDyn_DestroyParam(HydroDyn_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyOutput(HydroDyn_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyMisc(HydroDyn_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(HydroDyn_DataData%Input)) then LB(1:1) = lbound(HydroDyn_DataData%Input) @@ -11078,21 +7220,9 @@ subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) end do deallocate(HydroDyn_DataData%Input) end if - if (allocated(HydroDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(HydroDyn_DataData%Input_Saved) - UB(1:1) = ubound(HydroDyn_DataData%Input_Saved) - do i1 = LB(1), UB(1) - call HydroDyn_DestroyInput(HydroDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(HydroDyn_DataData%Input_Saved) - end if if (allocated(HydroDyn_DataData%InputTimes)) then deallocate(HydroDyn_DataData%InputTimes) end if - if (allocated(HydroDyn_DataData%InputTimes_Saved)) then - deallocate(HydroDyn_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackHydroDyn_Data(RF, Indata) @@ -11102,40 +7232,46 @@ subroutine FAST_PackHydroDyn_Data(RF, Indata) integer(B4Ki) :: i1 integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) - do i1 = LB(1), UB(1) - call HydroDyn_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) - do i1 = LB(1), UB(1) - call HydroDyn_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) - do i1 = LB(1), UB(1) - call HydroDyn_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) - do i1 = LB(1), UB(1) - call HydroDyn_PackOtherState(RF, InData%OtherSt(i1)) - end do - call HydroDyn_PackParam(RF, InData%p) - call HydroDyn_PackInput(RF, InData%u) - call HydroDyn_PackOutput(RF, InData%y) - call HydroDyn_PackMisc(RF, InData%m) - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call HydroDyn_PackContState(RF, InData%x(i1)) + end do + end if + call HydroDyn_PackContState(RF, InData%dxdt) + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call HydroDyn_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call HydroDyn_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) - call HydroDyn_PackOutput(RF, InData%Output(i1)) + call HydroDyn_PackOtherState(RF, InData%OtherSt(i1)) end do end if - call HydroDyn_PackOutput(RF, InData%y_interp) + call HydroDyn_PackParam(RF, InData%p) + call HydroDyn_PackOutput(RF, InData%y) + call HydroDyn_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) @@ -11145,17 +7281,7 @@ subroutine FAST_PackHydroDyn_Data(RF, Indata) call HydroDyn_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) - LB(1:1) = lbound(InData%Input_Saved) - UB(1:1) = ubound(InData%Input_Saved) - do i1 = LB(1), UB(1) - call HydroDyn_PackInput(RF, InData%Input_Saved(i1)) - end do - end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -11168,72 +7294,76 @@ subroutine FAST_UnPackHydroDyn_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) - do i1 = LB(1), UB(1) - call HydroDyn_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) - do i1 = LB(1), UB(1) - call HydroDyn_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) - do i1 = LB(1), UB(1) - call HydroDyn_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) - do i1 = LB(1), UB(1) - call HydroDyn_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do - call HydroDyn_UnpackParam(RF, OutData%p) ! p - call HydroDyn_UnpackInput(RF, OutData%u) ! u - call HydroDyn_UnpackOutput(RF, OutData%y) ! y - call HydroDyn_UnpackMisc(RF, OutData%m) ! m - if (allocated(OutData%Output)) deallocate(OutData%Output) + if (allocated(OutData%x)) deallocate(OutData%x) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) + allocate(OutData%x(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call HydroDyn_UnpackOutput(RF, OutData%Output(i1)) ! Output + call HydroDyn_UnpackContState(RF, OutData%x(i1)) ! x end do end if - call HydroDyn_UnpackOutput(RF, OutData%y_interp) ! y_interp - if (allocated(OutData%Input)) deallocate(OutData%Input) + call HydroDyn_UnpackContState(RF, OutData%dxdt) ! dxdt + if (allocated(OutData%xd)) deallocate(OutData%xd) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input(LB(1):UB(1)),stat=stat) + allocate(OutData%xd(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call HydroDyn_UnpackInput(RF, OutData%Input(i1)) ! Input + call HydroDyn_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call HydroDyn_UnpackParam(RF, OutData%p) ! p + call HydroDyn_UnpackOutput(RF, OutData%y) ! y + call HydroDyn_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call HydroDyn_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + call HydroDyn_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlCode, ErrStat, ErrMsg) @@ -11249,40 +7379,73 @@ subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlC character(*), parameter :: RoutineName = 'FAST_CopyIceFloe_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcIceFloe_DataData%x) - UB(1:1) = ubound(SrcIceFloe_DataData%x) - do i1 = LB(1), UB(1) - call IceFloe_CopyContState(SrcIceFloe_DataData%x(i1), DstIceFloe_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcIceFloe_DataData%xd) - UB(1:1) = ubound(SrcIceFloe_DataData%xd) - do i1 = LB(1), UB(1) - call IceFloe_CopyDiscState(SrcIceFloe_DataData%xd(i1), DstIceFloe_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcIceFloe_DataData%z) - UB(1:1) = ubound(SrcIceFloe_DataData%z) - do i1 = LB(1), UB(1) - call IceFloe_CopyConstrState(SrcIceFloe_DataData%z(i1), DstIceFloe_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcIceFloe_DataData%OtherSt) - UB(1:1) = ubound(SrcIceFloe_DataData%OtherSt) - do i1 = LB(1), UB(1) - call IceFloe_CopyOtherState(SrcIceFloe_DataData%OtherSt(i1), DstIceFloe_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + if (allocated(SrcIceFloe_DataData%x)) then + LB(1:1) = lbound(SrcIceFloe_DataData%x) + UB(1:1) = ubound(SrcIceFloe_DataData%x) + if (.not. allocated(DstIceFloe_DataData%x)) then + allocate(DstIceFloe_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceFloe_CopyContState(SrcIceFloe_DataData%x(i1), DstIceFloe_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcIceFloe_DataData%xd)) then + LB(1:1) = lbound(SrcIceFloe_DataData%xd) + UB(1:1) = ubound(SrcIceFloe_DataData%xd) + if (.not. allocated(DstIceFloe_DataData%xd)) then + allocate(DstIceFloe_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceFloe_CopyDiscState(SrcIceFloe_DataData%xd(i1), DstIceFloe_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcIceFloe_DataData%z)) then + LB(1:1) = lbound(SrcIceFloe_DataData%z) + UB(1:1) = ubound(SrcIceFloe_DataData%z) + if (.not. allocated(DstIceFloe_DataData%z)) then + allocate(DstIceFloe_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceFloe_CopyConstrState(SrcIceFloe_DataData%z(i1), DstIceFloe_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcIceFloe_DataData%OtherSt)) then + LB(1:1) = lbound(SrcIceFloe_DataData%OtherSt) + UB(1:1) = ubound(SrcIceFloe_DataData%OtherSt) + if (.not. allocated(DstIceFloe_DataData%OtherSt)) then + allocate(DstIceFloe_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceFloe_CopyOtherState(SrcIceFloe_DataData%OtherSt(i1), DstIceFloe_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if 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 @@ -11305,22 +7468,6 @@ subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlC if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcIceFloe_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcIceFloe_DataData%Input_Saved) - UB(1:1) = ubound(SrcIceFloe_DataData%Input_Saved) - if (.not. allocated(DstIceFloe_DataData%Input_Saved)) then - allocate(DstIceFloe_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call IceFloe_CopyInput(SrcIceFloe_DataData%Input_Saved(i1), DstIceFloe_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcIceFloe_DataData%InputTimes)) then LB(1:1) = lbound(SrcIceFloe_DataData%InputTimes) UB(1:1) = ubound(SrcIceFloe_DataData%InputTimes) @@ -11333,18 +7480,6 @@ subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlC end if DstIceFloe_DataData%InputTimes = SrcIceFloe_DataData%InputTimes end if - if (allocated(SrcIceFloe_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcIceFloe_DataData%InputTimes_Saved) - UB(1:1) = ubound(SrcIceFloe_DataData%InputTimes_Saved) - if (.not. allocated(DstIceFloe_DataData%InputTimes_Saved)) then - allocate(DstIceFloe_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstIceFloe_DataData%InputTimes_Saved = SrcIceFloe_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyIceFloe_Data(IceFloe_DataData, ErrStat, ErrMsg) @@ -11358,34 +7493,44 @@ subroutine FAST_DestroyIceFloe_Data(IceFloe_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyIceFloe_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(IceFloe_DataData%x) - UB(1:1) = ubound(IceFloe_DataData%x) - do i1 = LB(1), UB(1) - call IceFloe_DestroyContState(IceFloe_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(IceFloe_DataData%xd) - UB(1:1) = ubound(IceFloe_DataData%xd) - do i1 = LB(1), UB(1) - call IceFloe_DestroyDiscState(IceFloe_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(IceFloe_DataData%z) - UB(1:1) = ubound(IceFloe_DataData%z) - do i1 = LB(1), UB(1) - call IceFloe_DestroyConstrState(IceFloe_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(IceFloe_DataData%OtherSt) - UB(1:1) = ubound(IceFloe_DataData%OtherSt) - do i1 = LB(1), UB(1) - call IceFloe_DestroyOtherState(IceFloe_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(IceFloe_DataData%x)) then + LB(1:1) = lbound(IceFloe_DataData%x) + UB(1:1) = ubound(IceFloe_DataData%x) + do i1 = LB(1), UB(1) + call IceFloe_DestroyContState(IceFloe_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceFloe_DataData%x) + end if + if (allocated(IceFloe_DataData%xd)) then + LB(1:1) = lbound(IceFloe_DataData%xd) + UB(1:1) = ubound(IceFloe_DataData%xd) + do i1 = LB(1), UB(1) + call IceFloe_DestroyDiscState(IceFloe_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceFloe_DataData%xd) + end if + if (allocated(IceFloe_DataData%z)) then + LB(1:1) = lbound(IceFloe_DataData%z) + UB(1:1) = ubound(IceFloe_DataData%z) + do i1 = LB(1), UB(1) + call IceFloe_DestroyConstrState(IceFloe_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceFloe_DataData%z) + end if + if (allocated(IceFloe_DataData%OtherSt)) then + LB(1:1) = lbound(IceFloe_DataData%OtherSt) + UB(1:1) = ubound(IceFloe_DataData%OtherSt) + do i1 = LB(1), UB(1) + call IceFloe_DestroyOtherState(IceFloe_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceFloe_DataData%OtherSt) + end if call IceFloe_DestroyParam(IceFloe_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call IceFloe_DestroyInput(IceFloe_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call IceFloe_DestroyOutput(IceFloe_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call IceFloe_DestroyMisc(IceFloe_DataData%m, ErrStat2, ErrMsg2) @@ -11399,21 +7544,9 @@ subroutine FAST_DestroyIceFloe_Data(IceFloe_DataData, ErrStat, ErrMsg) end do deallocate(IceFloe_DataData%Input) end if - if (allocated(IceFloe_DataData%Input_Saved)) then - LB(1:1) = lbound(IceFloe_DataData%Input_Saved) - UB(1:1) = ubound(IceFloe_DataData%Input_Saved) - do i1 = LB(1), UB(1) - call IceFloe_DestroyInput(IceFloe_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(IceFloe_DataData%Input_Saved) - end if if (allocated(IceFloe_DataData%InputTimes)) then deallocate(IceFloe_DataData%InputTimes) end if - if (allocated(IceFloe_DataData%InputTimes_Saved)) then - deallocate(IceFloe_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackIceFloe_Data(RF, Indata) @@ -11423,28 +7556,43 @@ subroutine FAST_PackIceFloe_Data(RF, Indata) integer(B4Ki) :: i1 integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) - do i1 = LB(1), UB(1) - call IceFloe_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) - do i1 = LB(1), UB(1) - call IceFloe_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) - do i1 = LB(1), UB(1) - call IceFloe_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) - do i1 = LB(1), UB(1) - call IceFloe_PackOtherState(RF, InData%OtherSt(i1)) - end do + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call IceFloe_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call IceFloe_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call IceFloe_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call IceFloe_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if call IceFloe_PackParam(RF, InData%p) - call IceFloe_PackInput(RF, InData%u) call IceFloe_PackOutput(RF, InData%y) call IceFloe_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) @@ -11456,17 +7604,7 @@ subroutine FAST_PackIceFloe_Data(RF, Indata) call IceFloe_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) - LB(1:1) = lbound(InData%Input_Saved) - UB(1:1) = ubound(InData%Input_Saved) - do i1 = LB(1), UB(1) - call IceFloe_PackInput(RF, InData%Input_Saved(i1)) - end do - end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -11479,58 +7617,75 @@ subroutine FAST_UnPackIceFloe_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) - do i1 = LB(1), UB(1) - call IceFloe_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) - do i1 = LB(1), UB(1) - call IceFloe_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) - do i1 = LB(1), UB(1) - call IceFloe_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) - do i1 = LB(1), UB(1) - call IceFloe_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do - call IceFloe_UnpackParam(RF, OutData%p) ! p - call IceFloe_UnpackInput(RF, OutData%u) ! u - call IceFloe_UnpackOutput(RF, OutData%y) ! y - call IceFloe_UnpackMisc(RF, OutData%m) ! m - if (allocated(OutData%Input)) deallocate(OutData%Input) + if (allocated(OutData%x)) deallocate(OutData%x) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input(LB(1):UB(1)),stat=stat) + allocate(OutData%x(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call IceFloe_UnpackInput(RF, OutData%Input(i1)) ! Input + call IceFloe_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackConstrState(RF, OutData%z(i1)) ! z end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + end if + call IceFloe_UnpackParam(RF, OutData%p) ! p + call IceFloe_UnpackOutput(RF, OutData%y) ! y + call IceFloe_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call IceFloe_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + call IceFloe_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat, ErrMsg) @@ -11546,59 +7701,67 @@ subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat character(*), parameter :: RoutineName = 'FAST_CopyMAP_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcMAP_DataData%x) - UB(1:1) = ubound(SrcMAP_DataData%x) - do i1 = LB(1), UB(1) - call MAP_CopyContState(SrcMAP_DataData%x(i1), DstMAP_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcMAP_DataData%xd) - UB(1:1) = ubound(SrcMAP_DataData%xd) - do i1 = LB(1), UB(1) - call MAP_CopyDiscState(SrcMAP_DataData%xd(i1), DstMAP_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcMAP_DataData%z) - UB(1:1) = ubound(SrcMAP_DataData%z) - do i1 = LB(1), UB(1) - call MAP_CopyConstrState(SrcMAP_DataData%z(i1), DstMAP_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + if (allocated(SrcMAP_DataData%x)) then + LB(1:1) = lbound(SrcMAP_DataData%x) + UB(1:1) = ubound(SrcMAP_DataData%x) + if (.not. allocated(DstMAP_DataData%x)) then + allocate(DstMAP_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MAP_CopyContState(SrcMAP_DataData%x(i1), DstMAP_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMAP_DataData%xd)) then + LB(1:1) = lbound(SrcMAP_DataData%xd) + UB(1:1) = ubound(SrcMAP_DataData%xd) + if (.not. allocated(DstMAP_DataData%xd)) then + allocate(DstMAP_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MAP_CopyDiscState(SrcMAP_DataData%xd(i1), DstMAP_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMAP_DataData%z)) then + LB(1:1) = lbound(SrcMAP_DataData%z) + UB(1:1) = ubound(SrcMAP_DataData%z) + if (.not. allocated(DstMAP_DataData%z)) then + allocate(DstMAP_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MAP_CopyConstrState(SrcMAP_DataData%z(i1), DstMAP_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if 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 MAP_CopyMisc(SrcMAP_DataData%m, DstMAP_DataData%m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - if (allocated(SrcMAP_DataData%Output)) then - LB(1:1) = lbound(SrcMAP_DataData%Output) - UB(1:1) = ubound(SrcMAP_DataData%Output) - if (.not. allocated(DstMAP_DataData%Output)) then - allocate(DstMAP_DataData%Output(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Output.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MAP_CopyOutput(SrcMAP_DataData%Output(i1), DstMAP_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - call MAP_CopyOutput(SrcMAP_DataData%y_interp, DstMAP_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call 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%Input)) then @@ -11617,22 +7780,6 @@ subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcMAP_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcMAP_DataData%Input_Saved) - UB(1:1) = ubound(SrcMAP_DataData%Input_Saved) - if (.not. allocated(DstMAP_DataData%Input_Saved)) then - allocate(DstMAP_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MAP_CopyInput(SrcMAP_DataData%Input_Saved(i1), DstMAP_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcMAP_DataData%InputTimes)) then LB(1:1) = lbound(SrcMAP_DataData%InputTimes) UB(1:1) = ubound(SrcMAP_DataData%InputTimes) @@ -11645,18 +7792,6 @@ subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat end if DstMAP_DataData%InputTimes = SrcMAP_DataData%InputTimes end if - if (allocated(SrcMAP_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcMAP_DataData%InputTimes_Saved) - UB(1:1) = ubound(SrcMAP_DataData%InputTimes_Saved) - if (.not. allocated(DstMAP_DataData%InputTimes_Saved)) then - allocate(DstMAP_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMAP_DataData%InputTimes_Saved = SrcMAP_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) @@ -11670,44 +7805,42 @@ subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyMAP_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(MAP_DataData%x) - UB(1:1) = ubound(MAP_DataData%x) - do i1 = LB(1), UB(1) - call MAP_DestroyContState(MAP_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(MAP_DataData%xd) - UB(1:1) = ubound(MAP_DataData%xd) - do i1 = LB(1), UB(1) - call MAP_DestroyDiscState(MAP_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(MAP_DataData%z) - UB(1:1) = ubound(MAP_DataData%z) - do i1 = LB(1), UB(1) - call MAP_DestroyConstrState(MAP_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(MAP_DataData%x)) then + LB(1:1) = lbound(MAP_DataData%x) + UB(1:1) = ubound(MAP_DataData%x) + do i1 = LB(1), UB(1) + call MAP_DestroyContState(MAP_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MAP_DataData%x) + end if + if (allocated(MAP_DataData%xd)) then + LB(1:1) = lbound(MAP_DataData%xd) + UB(1:1) = ubound(MAP_DataData%xd) + do i1 = LB(1), UB(1) + call MAP_DestroyDiscState(MAP_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MAP_DataData%xd) + end if + if (allocated(MAP_DataData%z)) then + LB(1:1) = lbound(MAP_DataData%z) + UB(1:1) = ubound(MAP_DataData%z) + do i1 = LB(1), UB(1) + call MAP_DestroyConstrState(MAP_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MAP_DataData%z) + end if call MAP_DestroyOtherState(MAP_DataData%OtherSt, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call MAP_DestroyParam(MAP_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MAP_DestroyInput(MAP_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call MAP_DestroyOutput(MAP_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MAP_DestroyOtherState(MAP_DataData%OtherSt_old, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(MAP_DataData%Output)) then - LB(1:1) = lbound(MAP_DataData%Output) - UB(1:1) = ubound(MAP_DataData%Output) - do i1 = LB(1), UB(1) - call MAP_DestroyOutput(MAP_DataData%Output(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MAP_DataData%Output) - end if - call MAP_DestroyOutput(MAP_DataData%y_interp, ErrStat2, ErrMsg2) + call MAP_DestroyMisc(MAP_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyOtherState(MAP_DataData%OtherSt_old, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MAP_DataData%Input)) then LB(1:1) = lbound(MAP_DataData%Input) @@ -11718,21 +7851,9 @@ subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) end do deallocate(MAP_DataData%Input) end if - if (allocated(MAP_DataData%Input_Saved)) then - LB(1:1) = lbound(MAP_DataData%Input_Saved) - UB(1:1) = ubound(MAP_DataData%Input_Saved) - do i1 = LB(1), UB(1) - call MAP_DestroyInput(MAP_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MAP_DataData%Input_Saved) - end if if (allocated(MAP_DataData%InputTimes)) then deallocate(MAP_DataData%InputTimes) end if - if (allocated(MAP_DataData%InputTimes_Saved)) then - deallocate(MAP_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackMAP_Data(RF, Indata) @@ -11742,36 +7863,38 @@ subroutine FAST_PackMAP_Data(RF, Indata) integer(B4Ki) :: i1 integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) - do i1 = LB(1), UB(1) - call MAP_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) - do i1 = LB(1), UB(1) - call MAP_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) - do i1 = LB(1), UB(1) - call MAP_PackConstrState(RF, InData%z(i1)) - end do + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call MAP_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call MAP_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call MAP_PackConstrState(RF, InData%z(i1)) + end do + end if call MAP_PackOtherState(RF, InData%OtherSt) call MAP_PackParam(RF, InData%p) - call MAP_PackInput(RF, InData%u) call MAP_PackOutput(RF, InData%y) + call MAP_PackMisc(RF, InData%m) call MAP_PackOtherState(RF, InData%OtherSt_old) - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) - do i1 = LB(1), UB(1) - call MAP_PackOutput(RF, InData%Output(i1)) - end do - end if - call MAP_PackOutput(RF, InData%y_interp) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) @@ -11781,17 +7904,7 @@ subroutine FAST_PackMAP_Data(RF, Indata) call MAP_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) - LB(1:1) = lbound(InData%Input_Saved) - UB(1:1) = ubound(InData%Input_Saved) - do i1 = LB(1), UB(1) - call MAP_PackInput(RF, InData%Input_Saved(i1)) - end do - end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -11804,68 +7917,64 @@ subroutine FAST_UnPackMAP_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) - do i1 = LB(1), UB(1) - call MAP_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) - do i1 = LB(1), UB(1) - call MAP_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) - do i1 = LB(1), UB(1) - call MAP_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - call MAP_UnpackOtherState(RF, OutData%OtherSt) ! OtherSt - call MAP_UnpackParam(RF, OutData%p) ! p - call MAP_UnpackInput(RF, OutData%u) ! u - call MAP_UnpackOutput(RF, OutData%y) ! y - call MAP_UnpackOtherState(RF, OutData%OtherSt_old) ! OtherSt_old - if (allocated(OutData%Output)) deallocate(OutData%Output) + if (allocated(OutData%x)) deallocate(OutData%x) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) + allocate(OutData%x(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MAP_UnpackOutput(RF, OutData%Output(i1)) ! Output + call MAP_UnpackContState(RF, OutData%x(i1)) ! x end do end if - call MAP_UnpackOutput(RF, OutData%y_interp) ! y_interp - if (allocated(OutData%Input)) deallocate(OutData%Input) + if (allocated(OutData%xd)) deallocate(OutData%xd) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input(LB(1):UB(1)),stat=stat) + allocate(OutData%xd(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MAP_UnpackInput(RF, OutData%Input(i1)) ! Input + call MAP_UnpackDiscState(RF, OutData%xd(i1)) ! xd end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + call MAP_UnpackOtherState(RF, OutData%OtherSt) ! OtherSt + call MAP_UnpackParam(RF, OutData%p) ! p + call MAP_UnpackOutput(RF, OutData%y) ! y + call MAP_UnpackMisc(RF, OutData%m) ! m + call MAP_UnpackOtherState(RF, OutData%OtherSt_old) ! OtherSt_old + if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MAP_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + call MAP_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataData, CtrlCode, ErrStat, ErrMsg) @@ -11881,40 +7990,73 @@ subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataDa character(*), parameter :: RoutineName = 'FAST_CopyFEAMooring_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcFEAMooring_DataData%x) - UB(1:1) = ubound(SrcFEAMooring_DataData%x) - do i1 = LB(1), UB(1) - call FEAM_CopyContState(SrcFEAMooring_DataData%x(i1), DstFEAMooring_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcFEAMooring_DataData%xd) - UB(1:1) = ubound(SrcFEAMooring_DataData%xd) - do i1 = LB(1), UB(1) - call FEAM_CopyDiscState(SrcFEAMooring_DataData%xd(i1), DstFEAMooring_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcFEAMooring_DataData%z) - UB(1:1) = ubound(SrcFEAMooring_DataData%z) - do i1 = LB(1), UB(1) - call FEAM_CopyConstrState(SrcFEAMooring_DataData%z(i1), DstFEAMooring_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcFEAMooring_DataData%OtherSt) - UB(1:1) = ubound(SrcFEAMooring_DataData%OtherSt) - do i1 = LB(1), UB(1) - call FEAM_CopyOtherState(SrcFEAMooring_DataData%OtherSt(i1), DstFEAMooring_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + if (allocated(SrcFEAMooring_DataData%x)) then + LB(1:1) = lbound(SrcFEAMooring_DataData%x) + UB(1:1) = ubound(SrcFEAMooring_DataData%x) + if (.not. allocated(DstFEAMooring_DataData%x)) then + allocate(DstFEAMooring_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FEAM_CopyContState(SrcFEAMooring_DataData%x(i1), DstFEAMooring_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcFEAMooring_DataData%xd)) then + LB(1:1) = lbound(SrcFEAMooring_DataData%xd) + UB(1:1) = ubound(SrcFEAMooring_DataData%xd) + if (.not. allocated(DstFEAMooring_DataData%xd)) then + allocate(DstFEAMooring_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FEAM_CopyDiscState(SrcFEAMooring_DataData%xd(i1), DstFEAMooring_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcFEAMooring_DataData%z)) then + LB(1:1) = lbound(SrcFEAMooring_DataData%z) + UB(1:1) = ubound(SrcFEAMooring_DataData%z) + if (.not. allocated(DstFEAMooring_DataData%z)) then + allocate(DstFEAMooring_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FEAM_CopyConstrState(SrcFEAMooring_DataData%z(i1), DstFEAMooring_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcFEAMooring_DataData%OtherSt)) then + LB(1:1) = lbound(SrcFEAMooring_DataData%OtherSt) + UB(1:1) = ubound(SrcFEAMooring_DataData%OtherSt) + if (.not. allocated(DstFEAMooring_DataData%OtherSt)) then + allocate(DstFEAMooring_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FEAM_CopyOtherState(SrcFEAMooring_DataData%OtherSt(i1), DstFEAMooring_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if 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 @@ -11937,22 +8079,6 @@ subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataDa if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcFEAMooring_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcFEAMooring_DataData%Input_Saved) - UB(1:1) = ubound(SrcFEAMooring_DataData%Input_Saved) - if (.not. allocated(DstFEAMooring_DataData%Input_Saved)) then - allocate(DstFEAMooring_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call FEAM_CopyInput(SrcFEAMooring_DataData%Input_Saved(i1), DstFEAMooring_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcFEAMooring_DataData%InputTimes)) then LB(1:1) = lbound(SrcFEAMooring_DataData%InputTimes) UB(1:1) = ubound(SrcFEAMooring_DataData%InputTimes) @@ -11965,18 +8091,6 @@ subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataDa end if DstFEAMooring_DataData%InputTimes = SrcFEAMooring_DataData%InputTimes end if - if (allocated(SrcFEAMooring_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcFEAMooring_DataData%InputTimes_Saved) - UB(1:1) = ubound(SrcFEAMooring_DataData%InputTimes_Saved) - if (.not. allocated(DstFEAMooring_DataData%InputTimes_Saved)) then - allocate(DstFEAMooring_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstFEAMooring_DataData%InputTimes_Saved = SrcFEAMooring_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyFEAMooring_Data(FEAMooring_DataData, ErrStat, ErrMsg) @@ -11990,34 +8104,44 @@ subroutine FAST_DestroyFEAMooring_Data(FEAMooring_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyFEAMooring_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(FEAMooring_DataData%x) - UB(1:1) = ubound(FEAMooring_DataData%x) - do i1 = LB(1), UB(1) - call FEAM_DestroyContState(FEAMooring_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(FEAMooring_DataData%xd) - UB(1:1) = ubound(FEAMooring_DataData%xd) - do i1 = LB(1), UB(1) - call FEAM_DestroyDiscState(FEAMooring_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(FEAMooring_DataData%z) - UB(1:1) = ubound(FEAMooring_DataData%z) - do i1 = LB(1), UB(1) - call FEAM_DestroyConstrState(FEAMooring_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(FEAMooring_DataData%OtherSt) - UB(1:1) = ubound(FEAMooring_DataData%OtherSt) - do i1 = LB(1), UB(1) - call FEAM_DestroyOtherState(FEAMooring_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(FEAMooring_DataData%x)) then + LB(1:1) = lbound(FEAMooring_DataData%x) + UB(1:1) = ubound(FEAMooring_DataData%x) + do i1 = LB(1), UB(1) + call FEAM_DestroyContState(FEAMooring_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(FEAMooring_DataData%x) + end if + if (allocated(FEAMooring_DataData%xd)) then + LB(1:1) = lbound(FEAMooring_DataData%xd) + UB(1:1) = ubound(FEAMooring_DataData%xd) + do i1 = LB(1), UB(1) + call FEAM_DestroyDiscState(FEAMooring_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(FEAMooring_DataData%xd) + end if + if (allocated(FEAMooring_DataData%z)) then + LB(1:1) = lbound(FEAMooring_DataData%z) + UB(1:1) = ubound(FEAMooring_DataData%z) + do i1 = LB(1), UB(1) + call FEAM_DestroyConstrState(FEAMooring_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(FEAMooring_DataData%z) + end if + if (allocated(FEAMooring_DataData%OtherSt)) then + LB(1:1) = lbound(FEAMooring_DataData%OtherSt) + UB(1:1) = ubound(FEAMooring_DataData%OtherSt) + do i1 = LB(1), UB(1) + call FEAM_DestroyOtherState(FEAMooring_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(FEAMooring_DataData%OtherSt) + end if call FEAM_DestroyParam(FEAMooring_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call FEAM_DestroyInput(FEAMooring_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FEAM_DestroyOutput(FEAMooring_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FEAM_DestroyMisc(FEAMooring_DataData%m, ErrStat2, ErrMsg2) @@ -12031,21 +8155,9 @@ subroutine FAST_DestroyFEAMooring_Data(FEAMooring_DataData, ErrStat, ErrMsg) end do deallocate(FEAMooring_DataData%Input) end if - if (allocated(FEAMooring_DataData%Input_Saved)) then - LB(1:1) = lbound(FEAMooring_DataData%Input_Saved) - UB(1:1) = ubound(FEAMooring_DataData%Input_Saved) - do i1 = LB(1), UB(1) - call FEAM_DestroyInput(FEAMooring_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(FEAMooring_DataData%Input_Saved) - end if if (allocated(FEAMooring_DataData%InputTimes)) then deallocate(FEAMooring_DataData%InputTimes) end if - if (allocated(FEAMooring_DataData%InputTimes_Saved)) then - deallocate(FEAMooring_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackFEAMooring_Data(RF, Indata) @@ -12055,28 +8167,43 @@ subroutine FAST_PackFEAMooring_Data(RF, Indata) integer(B4Ki) :: i1 integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) - do i1 = LB(1), UB(1) - call FEAM_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) - do i1 = LB(1), UB(1) - call FEAM_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) - do i1 = LB(1), UB(1) - call FEAM_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) - do i1 = LB(1), UB(1) - call FEAM_PackOtherState(RF, InData%OtherSt(i1)) - end do + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call FEAM_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call FEAM_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call FEAM_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call FEAM_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if call FEAM_PackParam(RF, InData%p) - call FEAM_PackInput(RF, InData%u) call FEAM_PackOutput(RF, InData%y) call FEAM_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) @@ -12085,84 +8212,91 @@ subroutine FAST_PackFEAMooring_Data(RF, Indata) LB(1:1) = lbound(InData%Input) UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) - call FEAM_PackInput(RF, InData%Input(i1)) + call FEAM_PackInput(RF, InData%Input(i1)) + end do + end if + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackFEAMooring_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FEAMooring_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackFEAMooring_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackDiscState(RF, OutData%xd(i1)) ! xd end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) - LB(1:1) = lbound(InData%Input_Saved) - UB(1:1) = ubound(InData%Input_Saved) + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if do i1 = LB(1), UB(1) - call FEAM_PackInput(RF, InData%Input_Saved(i1)) + call FEAM_UnpackConstrState(RF, OutData%z(i1)) ! z end do end if - call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine FAST_UnPackFEAMooring_Data(RF, OutData) - type(RegFile), intent(inout) :: RF - type(FEAMooring_Data), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackFEAMooring_Data' - integer(B4Ki) :: i1 - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) - do i1 = LB(1), UB(1) - call FEAM_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) - do i1 = LB(1), UB(1) - call FEAM_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) - do i1 = LB(1), UB(1) - call FEAM_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) - do i1 = LB(1), UB(1) - call FEAM_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do - call FEAM_UnpackParam(RF, OutData%p) ! p - call FEAM_UnpackInput(RF, OutData%u) ! u - call FEAM_UnpackOutput(RF, OutData%y) ! y - call FEAM_UnpackMisc(RF, OutData%m) ! m - if (allocated(OutData%Input)) deallocate(OutData%Input) + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input(LB(1):UB(1)),stat=stat) + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call FEAM_UnpackInput(RF, OutData%Input(i1)) ! Input + call FEAM_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call FEAM_UnpackParam(RF, OutData%p) ! p + call FEAM_UnpackOutput(RF, OutData%y) ! y + call FEAM_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call FEAM_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + call FEAM_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlCode, ErrStat, ErrMsg) @@ -12178,93 +8312,91 @@ subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlC character(*), parameter :: RoutineName = 'FAST_CopyMoorDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcMoorDyn_DataData%x) - UB(1:1) = ubound(SrcMoorDyn_DataData%x) - do i1 = LB(1), UB(1) - call MD_CopyContState(SrcMoorDyn_DataData%x(i1), DstMoorDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcMoorDyn_DataData%xd) - UB(1:1) = ubound(SrcMoorDyn_DataData%xd) - do i1 = LB(1), UB(1) - call MD_CopyDiscState(SrcMoorDyn_DataData%xd(i1), DstMoorDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcMoorDyn_DataData%z) - UB(1:1) = ubound(SrcMoorDyn_DataData%z) - do i1 = LB(1), UB(1) - call MD_CopyConstrState(SrcMoorDyn_DataData%z(i1), DstMoorDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcMoorDyn_DataData%OtherSt) - UB(1:1) = ubound(SrcMoorDyn_DataData%OtherSt) - do i1 = LB(1), UB(1) - call MD_CopyOtherState(SrcMoorDyn_DataData%OtherSt(i1), DstMoorDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - call MD_CopyParam(SrcMoorDyn_DataData%p, DstMoorDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MD_CopyInput(SrcMoorDyn_DataData%u, DstMoorDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MD_CopyOutput(SrcMoorDyn_DataData%y, DstMoorDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MD_CopyMisc(SrcMoorDyn_DataData%m, DstMoorDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcMoorDyn_DataData%Output)) then - LB(1:1) = lbound(SrcMoorDyn_DataData%Output) - UB(1:1) = ubound(SrcMoorDyn_DataData%Output) - if (.not. allocated(DstMoorDyn_DataData%Output)) then - allocate(DstMoorDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMoorDyn_DataData%x)) then + LB(1:1) = lbound(SrcMoorDyn_DataData%x) + UB(1:1) = ubound(SrcMoorDyn_DataData%x) + if (.not. allocated(DstMoorDyn_DataData%x)) then + allocate(DstMoorDyn_DataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%x.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MD_CopyOutput(SrcMoorDyn_DataData%Output(i1), DstMoorDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call MD_CopyContState(SrcMoorDyn_DataData%x(i1), DstMoorDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - call MD_CopyOutput(SrcMoorDyn_DataData%y_interp, DstMoorDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcMoorDyn_DataData%Input)) then - LB(1:1) = lbound(SrcMoorDyn_DataData%Input) - UB(1:1) = ubound(SrcMoorDyn_DataData%Input) - if (.not. allocated(DstMoorDyn_DataData%Input)) then - allocate(DstMoorDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMoorDyn_DataData%xd)) then + LB(1:1) = lbound(SrcMoorDyn_DataData%xd) + UB(1:1) = ubound(SrcMoorDyn_DataData%xd) + if (.not. allocated(DstMoorDyn_DataData%xd)) then + allocate(DstMoorDyn_DataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%xd.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MD_CopyInput(SrcMoorDyn_DataData%Input(i1), DstMoorDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call MD_CopyDiscState(SrcMoorDyn_DataData%xd(i1), DstMoorDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMoorDyn_DataData%z)) then + LB(1:1) = lbound(SrcMoorDyn_DataData%z) + UB(1:1) = ubound(SrcMoorDyn_DataData%z) + if (.not. allocated(DstMoorDyn_DataData%z)) then + allocate(DstMoorDyn_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyConstrState(SrcMoorDyn_DataData%z(i1), DstMoorDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMoorDyn_DataData%OtherSt)) then + LB(1:1) = lbound(SrcMoorDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcMoorDyn_DataData%OtherSt) + if (.not. allocated(DstMoorDyn_DataData%OtherSt)) then + allocate(DstMoorDyn_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyOtherState(SrcMoorDyn_DataData%OtherSt(i1), DstMoorDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcMoorDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcMoorDyn_DataData%Input_Saved) - UB(1:1) = ubound(SrcMoorDyn_DataData%Input_Saved) - if (.not. allocated(DstMoorDyn_DataData%Input_Saved)) then - allocate(DstMoorDyn_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + 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_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 + LB(1:1) = lbound(SrcMoorDyn_DataData%Input) + UB(1:1) = ubound(SrcMoorDyn_DataData%Input) + if (.not. allocated(DstMoorDyn_DataData%Input)) then + allocate(DstMoorDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MD_CopyInput(SrcMoorDyn_DataData%Input_Saved(i1), DstMoorDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + call MD_CopyInput(SrcMoorDyn_DataData%Input(i1), DstMoorDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do @@ -12281,18 +8413,6 @@ subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlC end if DstMoorDyn_DataData%InputTimes = SrcMoorDyn_DataData%InputTimes end if - if (allocated(SrcMoorDyn_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcMoorDyn_DataData%InputTimes_Saved) - UB(1:1) = ubound(SrcMoorDyn_DataData%InputTimes_Saved) - if (.not. allocated(DstMoorDyn_DataData%InputTimes_Saved)) then - allocate(DstMoorDyn_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMoorDyn_DataData%InputTimes_Saved = SrcMoorDyn_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) @@ -12306,49 +8426,48 @@ subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyMoorDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(MoorDyn_DataData%x) - UB(1:1) = ubound(MoorDyn_DataData%x) - do i1 = LB(1), UB(1) - call MD_DestroyContState(MoorDyn_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(MoorDyn_DataData%xd) - UB(1:1) = ubound(MoorDyn_DataData%xd) - do i1 = LB(1), UB(1) - call MD_DestroyDiscState(MoorDyn_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(MoorDyn_DataData%z) - UB(1:1) = ubound(MoorDyn_DataData%z) - do i1 = LB(1), UB(1) - call MD_DestroyConstrState(MoorDyn_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(MoorDyn_DataData%OtherSt) - UB(1:1) = ubound(MoorDyn_DataData%OtherSt) - do i1 = LB(1), UB(1) - call MD_DestroyOtherState(MoorDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(MoorDyn_DataData%x)) then + LB(1:1) = lbound(MoorDyn_DataData%x) + UB(1:1) = ubound(MoorDyn_DataData%x) + do i1 = LB(1), UB(1) + call MD_DestroyContState(MoorDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MoorDyn_DataData%x) + end if + if (allocated(MoorDyn_DataData%xd)) then + LB(1:1) = lbound(MoorDyn_DataData%xd) + UB(1:1) = ubound(MoorDyn_DataData%xd) + do i1 = LB(1), UB(1) + call MD_DestroyDiscState(MoorDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MoorDyn_DataData%xd) + end if + if (allocated(MoorDyn_DataData%z)) then + LB(1:1) = lbound(MoorDyn_DataData%z) + UB(1:1) = ubound(MoorDyn_DataData%z) + do i1 = LB(1), UB(1) + call MD_DestroyConstrState(MoorDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MoorDyn_DataData%z) + end if + if (allocated(MoorDyn_DataData%OtherSt)) then + LB(1:1) = lbound(MoorDyn_DataData%OtherSt) + UB(1:1) = ubound(MoorDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call MD_DestroyOtherState(MoorDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MoorDyn_DataData%OtherSt) + end if call MD_DestroyParam(MoorDyn_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MD_DestroyInput(MoorDyn_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call MD_DestroyOutput(MoorDyn_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call MD_DestroyMisc(MoorDyn_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(MoorDyn_DataData%Output)) then - LB(1:1) = lbound(MoorDyn_DataData%Output) - UB(1:1) = ubound(MoorDyn_DataData%Output) - do i1 = LB(1), UB(1) - call MD_DestroyOutput(MoorDyn_DataData%Output(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MoorDyn_DataData%Output) - end if - call MD_DestroyOutput(MoorDyn_DataData%y_interp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MoorDyn_DataData%Input)) then LB(1:1) = lbound(MoorDyn_DataData%Input) UB(1:1) = ubound(MoorDyn_DataData%Input) @@ -12358,21 +8477,9 @@ subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) end do deallocate(MoorDyn_DataData%Input) end if - if (allocated(MoorDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(MoorDyn_DataData%Input_Saved) - UB(1:1) = ubound(MoorDyn_DataData%Input_Saved) - do i1 = LB(1), UB(1) - call MD_DestroyInput(MoorDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MoorDyn_DataData%Input_Saved) - end if if (allocated(MoorDyn_DataData%InputTimes)) then deallocate(MoorDyn_DataData%InputTimes) end if - if (allocated(MoorDyn_DataData%InputTimes_Saved)) then - deallocate(MoorDyn_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackMoorDyn_Data(RF, Indata) @@ -12382,40 +8489,45 @@ subroutine FAST_PackMoorDyn_Data(RF, Indata) integer(B4Ki) :: i1 integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) - do i1 = LB(1), UB(1) - call MD_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) - do i1 = LB(1), UB(1) - call MD_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) - do i1 = LB(1), UB(1) - call MD_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) - do i1 = LB(1), UB(1) - call MD_PackOtherState(RF, InData%OtherSt(i1)) - end do - call MD_PackParam(RF, InData%p) - call MD_PackInput(RF, InData%u) - call MD_PackOutput(RF, InData%y) - call MD_PackMisc(RF, InData%m) - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call MD_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call MD_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) - call MD_PackOutput(RF, InData%Output(i1)) + call MD_PackConstrState(RF, InData%z(i1)) end do end if - call MD_PackOutput(RF, InData%y_interp) + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call MD_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if + call MD_PackParam(RF, InData%p) + call MD_PackOutput(RF, InData%y) + call MD_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) @@ -12425,17 +8537,7 @@ subroutine FAST_PackMoorDyn_Data(RF, Indata) call MD_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) - LB(1:1) = lbound(InData%Input_Saved) - UB(1:1) = ubound(InData%Input_Saved) - do i1 = LB(1), UB(1) - call MD_PackInput(RF, InData%Input_Saved(i1)) - end do - end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -12448,72 +8550,75 @@ subroutine FAST_UnPackMoorDyn_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) - do i1 = LB(1), UB(1) - call MD_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) - do i1 = LB(1), UB(1) - call MD_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) - do i1 = LB(1), UB(1) - call MD_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) - do i1 = LB(1), UB(1) - call MD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do - call MD_UnpackParam(RF, OutData%p) ! p - call MD_UnpackInput(RF, OutData%u) ! u - call MD_UnpackOutput(RF, OutData%y) ! y - call MD_UnpackMisc(RF, OutData%m) ! m - if (allocated(OutData%Output)) deallocate(OutData%Output) + if (allocated(OutData%x)) deallocate(OutData%x) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) + allocate(OutData%x(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackOutput(RF, OutData%Output(i1)) ! Output + call MD_UnpackContState(RF, OutData%x(i1)) ! x end do end if - call MD_UnpackOutput(RF, OutData%y_interp) ! y_interp - if (allocated(OutData%Input)) deallocate(OutData%Input) + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input(LB(1):UB(1)),stat=stat) + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackInput(RF, OutData%Input(i1)) ! Input + call MD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call MD_UnpackParam(RF, OutData%p) ! p + call MD_UnpackOutput(RF, OutData%y) ! y + call MD_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + call MD_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, CtrlCode, ErrStat, ErrMsg) @@ -12529,40 +8634,73 @@ subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, Ct character(*), parameter :: RoutineName = 'FAST_CopyOrcaFlex_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcOrcaFlex_DataData%x) - UB(1:1) = ubound(SrcOrcaFlex_DataData%x) - do i1 = LB(1), UB(1) - call Orca_CopyContState(SrcOrcaFlex_DataData%x(i1), DstOrcaFlex_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcOrcaFlex_DataData%xd) - UB(1:1) = ubound(SrcOrcaFlex_DataData%xd) - do i1 = LB(1), UB(1) - call Orca_CopyDiscState(SrcOrcaFlex_DataData%xd(i1), DstOrcaFlex_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcOrcaFlex_DataData%z) - UB(1:1) = ubound(SrcOrcaFlex_DataData%z) - do i1 = LB(1), UB(1) - call Orca_CopyConstrState(SrcOrcaFlex_DataData%z(i1), DstOrcaFlex_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - LB(1:1) = lbound(SrcOrcaFlex_DataData%OtherSt) - UB(1:1) = ubound(SrcOrcaFlex_DataData%OtherSt) - do i1 = LB(1), UB(1) - call Orca_CopyOtherState(SrcOrcaFlex_DataData%OtherSt(i1), DstOrcaFlex_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + if (allocated(SrcOrcaFlex_DataData%x)) then + LB(1:1) = lbound(SrcOrcaFlex_DataData%x) + UB(1:1) = ubound(SrcOrcaFlex_DataData%x) + if (.not. allocated(DstOrcaFlex_DataData%x)) then + allocate(DstOrcaFlex_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Orca_CopyContState(SrcOrcaFlex_DataData%x(i1), DstOrcaFlex_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOrcaFlex_DataData%xd)) then + LB(1:1) = lbound(SrcOrcaFlex_DataData%xd) + UB(1:1) = ubound(SrcOrcaFlex_DataData%xd) + if (.not. allocated(DstOrcaFlex_DataData%xd)) then + allocate(DstOrcaFlex_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Orca_CopyDiscState(SrcOrcaFlex_DataData%xd(i1), DstOrcaFlex_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOrcaFlex_DataData%z)) then + LB(1:1) = lbound(SrcOrcaFlex_DataData%z) + UB(1:1) = ubound(SrcOrcaFlex_DataData%z) + if (.not. allocated(DstOrcaFlex_DataData%z)) then + allocate(DstOrcaFlex_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Orca_CopyConstrState(SrcOrcaFlex_DataData%z(i1), DstOrcaFlex_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOrcaFlex_DataData%OtherSt)) then + LB(1:1) = lbound(SrcOrcaFlex_DataData%OtherSt) + UB(1:1) = ubound(SrcOrcaFlex_DataData%OtherSt) + if (.not. allocated(DstOrcaFlex_DataData%OtherSt)) then + allocate(DstOrcaFlex_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Orca_CopyOtherState(SrcOrcaFlex_DataData%OtherSt(i1), DstOrcaFlex_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if 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 @@ -12585,22 +8723,6 @@ subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, Ct if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcOrcaFlex_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcOrcaFlex_DataData%Input_Saved) - UB(1:1) = ubound(SrcOrcaFlex_DataData%Input_Saved) - if (.not. allocated(DstOrcaFlex_DataData%Input_Saved)) then - allocate(DstOrcaFlex_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call Orca_CopyInput(SrcOrcaFlex_DataData%Input_Saved(i1), DstOrcaFlex_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcOrcaFlex_DataData%InputTimes)) then LB(1:1) = lbound(SrcOrcaFlex_DataData%InputTimes) UB(1:1) = ubound(SrcOrcaFlex_DataData%InputTimes) @@ -12613,18 +8735,6 @@ subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, Ct end if DstOrcaFlex_DataData%InputTimes = SrcOrcaFlex_DataData%InputTimes end if - if (allocated(SrcOrcaFlex_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcOrcaFlex_DataData%InputTimes_Saved) - UB(1:1) = ubound(SrcOrcaFlex_DataData%InputTimes_Saved) - if (.not. allocated(DstOrcaFlex_DataData%InputTimes_Saved)) then - allocate(DstOrcaFlex_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstOrcaFlex_DataData%InputTimes_Saved = SrcOrcaFlex_DataData%InputTimes_Saved - end if end subroutine subroutine FAST_DestroyOrcaFlex_Data(OrcaFlex_DataData, ErrStat, ErrMsg) @@ -12638,34 +8748,44 @@ subroutine FAST_DestroyOrcaFlex_Data(OrcaFlex_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyOrcaFlex_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(OrcaFlex_DataData%x) - UB(1:1) = ubound(OrcaFlex_DataData%x) - do i1 = LB(1), UB(1) - call Orca_DestroyContState(OrcaFlex_DataData%x(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(OrcaFlex_DataData%xd) - UB(1:1) = ubound(OrcaFlex_DataData%xd) - do i1 = LB(1), UB(1) - call Orca_DestroyDiscState(OrcaFlex_DataData%xd(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(OrcaFlex_DataData%z) - UB(1:1) = ubound(OrcaFlex_DataData%z) - do i1 = LB(1), UB(1) - call Orca_DestroyConstrState(OrcaFlex_DataData%z(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - LB(1:1) = lbound(OrcaFlex_DataData%OtherSt) - UB(1:1) = ubound(OrcaFlex_DataData%OtherSt) - do i1 = LB(1), UB(1) - call Orca_DestroyOtherState(OrcaFlex_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do + if (allocated(OrcaFlex_DataData%x)) then + LB(1:1) = lbound(OrcaFlex_DataData%x) + UB(1:1) = ubound(OrcaFlex_DataData%x) + do i1 = LB(1), UB(1) + call Orca_DestroyContState(OrcaFlex_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OrcaFlex_DataData%x) + end if + if (allocated(OrcaFlex_DataData%xd)) then + LB(1:1) = lbound(OrcaFlex_DataData%xd) + UB(1:1) = ubound(OrcaFlex_DataData%xd) + do i1 = LB(1), UB(1) + call Orca_DestroyDiscState(OrcaFlex_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OrcaFlex_DataData%xd) + end if + if (allocated(OrcaFlex_DataData%z)) then + LB(1:1) = lbound(OrcaFlex_DataData%z) + UB(1:1) = ubound(OrcaFlex_DataData%z) + do i1 = LB(1), UB(1) + call Orca_DestroyConstrState(OrcaFlex_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OrcaFlex_DataData%z) + end if + if (allocated(OrcaFlex_DataData%OtherSt)) then + LB(1:1) = lbound(OrcaFlex_DataData%OtherSt) + UB(1:1) = ubound(OrcaFlex_DataData%OtherSt) + do i1 = LB(1), UB(1) + call Orca_DestroyOtherState(OrcaFlex_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OrcaFlex_DataData%OtherSt) + end if call Orca_DestroyParam(OrcaFlex_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call Orca_DestroyInput(OrcaFlex_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call Orca_DestroyOutput(OrcaFlex_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call Orca_DestroyMisc(OrcaFlex_DataData%m, ErrStat2, ErrMsg2) @@ -12679,21 +8799,9 @@ subroutine FAST_DestroyOrcaFlex_Data(OrcaFlex_DataData, ErrStat, ErrMsg) end do deallocate(OrcaFlex_DataData%Input) end if - if (allocated(OrcaFlex_DataData%Input_Saved)) then - LB(1:1) = lbound(OrcaFlex_DataData%Input_Saved) - UB(1:1) = ubound(OrcaFlex_DataData%Input_Saved) - do i1 = LB(1), UB(1) - call Orca_DestroyInput(OrcaFlex_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(OrcaFlex_DataData%Input_Saved) - end if if (allocated(OrcaFlex_DataData%InputTimes)) then deallocate(OrcaFlex_DataData%InputTimes) end if - if (allocated(OrcaFlex_DataData%InputTimes_Saved)) then - deallocate(OrcaFlex_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackOrcaFlex_Data(RF, Indata) @@ -12703,28 +8811,43 @@ subroutine FAST_PackOrcaFlex_Data(RF, Indata) integer(B4Ki) :: i1 integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) - do i1 = LB(1), UB(1) - call Orca_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) - do i1 = LB(1), UB(1) - call Orca_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) - do i1 = LB(1), UB(1) - call Orca_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) - do i1 = LB(1), UB(1) - call Orca_PackOtherState(RF, InData%OtherSt(i1)) - end do + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call Orca_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call Orca_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call Orca_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call Orca_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if call Orca_PackParam(RF, InData%p) - call Orca_PackInput(RF, InData%u) call Orca_PackOutput(RF, InData%y) call Orca_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%Input)) @@ -12736,17 +8859,7 @@ subroutine FAST_PackOrcaFlex_Data(RF, Indata) call Orca_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(RF, allocated(InData%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) - LB(1:1) = lbound(InData%Input_Saved) - UB(1:1) = ubound(InData%Input_Saved) - do i1 = LB(1), UB(1) - call Orca_PackInput(RF, InData%Input_Saved(i1)) - end do - end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -12759,58 +8872,75 @@ subroutine FAST_UnPackOrcaFlex_Data(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) - do i1 = LB(1), UB(1) - call Orca_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) - do i1 = LB(1), UB(1) - call Orca_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) - do i1 = LB(1), UB(1) - call Orca_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) - do i1 = LB(1), UB(1) - call Orca_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt - end do - call Orca_UnpackParam(RF, OutData%p) ! p - call Orca_UnpackInput(RF, OutData%u) ! u - call Orca_UnpackOutput(RF, OutData%y) ! y - call Orca_UnpackMisc(RF, OutData%m) ! m - if (allocated(OutData%Input)) deallocate(OutData%Input) + if (allocated(OutData%x)) deallocate(OutData%x) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input(LB(1):UB(1)),stat=stat) + allocate(OutData%x(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call Orca_UnpackInput(RF, OutData%Input(i1)) ! Input + call Orca_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Orca_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Orca_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Orca_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call Orca_UnpackParam(RF, OutData%p) ! p + call Orca_UnpackOutput(RF, OutData%y) ! y + call Orca_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call Orca_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + call Orca_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, CtrlCode, ErrStat, ErrMsg) @@ -14855,9 +10985,22 @@ subroutine FAST_CopyInitData(SrcInitDataData, DstInitDataData, CtrlCode, ErrStat 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 + if (allocated(SrcInitDataData%OutData_ED)) then + LB(1:1) = lbound(SrcInitDataData%OutData_ED) + UB(1:1) = ubound(SrcInitDataData%OutData_ED) + if (.not. allocated(DstInitDataData%OutData_ED)) then + allocate(DstInitDataData%OutData_ED(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitDataData%OutData_ED.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyInitOutput(SrcInitDataData%OutData_ED(i1), DstInitDataData%OutData_ED(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if call SED_CopyInitInput(SrcInitDataData%InData_SED, DstInitDataData%InData_SED, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -14994,8 +11137,15 @@ subroutine FAST_DestroyInitData(InitDataData, ErrStat, ErrMsg) ErrMsg = '' call ED_DestroyInitInput(InitDataData%InData_ED, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call ED_DestroyInitOutput(InitDataData%OutData_ED, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitDataData%OutData_ED)) then + LB(1:1) = lbound(InitDataData%OutData_ED) + UB(1:1) = ubound(InitDataData%OutData_ED) + do i1 = LB(1), UB(1) + call ED_DestroyInitOutput(InitDataData%OutData_ED(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitDataData%OutData_ED) + end if call SED_DestroyInitInput(InitDataData%InData_SED, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SED_DestroyInitOutput(InitDataData%OutData_SED, ErrStat2, ErrMsg2) @@ -15085,7 +11235,15 @@ subroutine FAST_PackInitData(RF, Indata) integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call ED_PackInitInput(RF, InData%InData_ED) - call ED_PackInitOutput(RF, InData%OutData_ED) + call RegPack(RF, allocated(InData%OutData_ED)) + if (allocated(InData%OutData_ED)) then + call RegPackBounds(RF, 1, lbound(InData%OutData_ED), ubound(InData%OutData_ED)) + LB(1:1) = lbound(InData%OutData_ED) + UB(1:1) = ubound(InData%OutData_ED) + do i1 = LB(1), UB(1) + call ED_PackInitOutput(RF, InData%OutData_ED(i1)) + end do + end if call SED_PackInitInput(RF, InData%InData_SED) call SED_PackInitOutput(RF, InData%OutData_SED) call BD_PackInitInput(RF, InData%InData_BD) @@ -15143,7 +11301,19 @@ subroutine FAST_UnPackInitData(RF, OutData) logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return call ED_UnpackInitInput(RF, OutData%InData_ED) ! InData_ED - call ED_UnpackInitOutput(RF, OutData%OutData_ED) ! OutData_ED + if (allocated(OutData%OutData_ED)) deallocate(OutData%OutData_ED) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutData_ED(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutData_ED.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackInitOutput(RF, OutData%OutData_ED(i1)) ! OutData_ED + end do + end if call SED_UnpackInitInput(RF, OutData%InData_SED) ! InData_SED call SED_UnpackInitOutput(RF, OutData%OutData_SED) ! OutData_SED call BD_UnpackInitInput(RF, OutData%InData_BD) ! InData_BD @@ -15353,6 +11523,15 @@ subroutine FAST_CopyTurbineType(SrcTurbineTypeData, DstTurbineTypeData, CtrlCode call FAST_CopyMisc(SrcTurbineTypeData%m_FAST, DstTurbineTypeData%m_FAST, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + call Glue_CopyParam(SrcTurbineTypeData%p_Glue, DstTurbineTypeData%p_Glue, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Glue_CopyOutputFileType(SrcTurbineTypeData%y_Glue, DstTurbineTypeData%y_Glue, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Glue_CopyMisc(SrcTurbineTypeData%m_Glue, DstTurbineTypeData%m_Glue, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return call FAST_CopyModuleMapType(SrcTurbineTypeData%MeshMapData, DstTurbineTypeData%MeshMapData, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -15433,6 +11612,12 @@ subroutine FAST_DestroyTurbineType(TurbineTypeData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FAST_DestroyMisc(TurbineTypeData%m_FAST, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyParam(TurbineTypeData%p_Glue, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyOutputFileType(TurbineTypeData%y_Glue, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyMisc(TurbineTypeData%m_Glue, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FAST_DestroyModuleMapType(TurbineTypeData%MeshMapData, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FAST_DestroyElastoDyn_Data(TurbineTypeData%ED, ErrStat2, ErrMsg2) @@ -15486,6 +11671,9 @@ subroutine FAST_PackTurbineType(RF, Indata) call FAST_PackParam(RF, InData%p_FAST) call FAST_PackOutputFileType(RF, InData%y_FAST) call FAST_PackMisc(RF, InData%m_FAST) + call Glue_PackParam(RF, InData%p_Glue) + call Glue_PackOutputFileType(RF, InData%y_Glue) + call Glue_PackMisc(RF, InData%m_Glue) call FAST_PackModuleMapType(RF, InData%MeshMapData) call FAST_PackElastoDyn_Data(RF, InData%ED) call FAST_PackSED_Data(RF, InData%SED) @@ -15519,6 +11707,9 @@ subroutine FAST_UnPackTurbineType(RF, OutData) call FAST_UnpackParam(RF, OutData%p_FAST) ! p_FAST call FAST_UnpackOutputFileType(RF, OutData%y_FAST) ! y_FAST call FAST_UnpackMisc(RF, OutData%m_FAST) ! m_FAST + call Glue_UnpackParam(RF, OutData%p_Glue) ! p_Glue + call Glue_UnpackOutputFileType(RF, OutData%y_Glue) ! y_Glue + call Glue_UnpackMisc(RF, OutData%m_Glue) ! m_Glue call FAST_UnpackModuleMapType(RF, OutData%MeshMapData) ! MeshMapData call FAST_UnpackElastoDyn_Data(RF, OutData%ED) ! ED call FAST_UnpackSED_Data(RF, OutData%SED) ! SED @@ -15541,5 +11732,7 @@ subroutine FAST_UnPackTurbineType(RF, OutData) call FAST_UnpackIceDyn_Data(RF, OutData%IceD) ! IceD call FAST_UnpackExtPtfm_Data(RF, OutData%ExtPtfm) ! ExtPtfm end subroutine + END MODULE FAST_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/openfast-library/src/Glue_Registry.txt b/modules/openfast-library/src/Glue_Registry.txt new file mode 100644 index 0000000000..df9d83bf34 --- /dev/null +++ b/modules/openfast-library/src/Glue_Registry.txt @@ -0,0 +1,197 @@ +#---------------------------------------------------------------------------------------------------------------------------------- +# Registry for FAST v8 in the FAST Modularization Framework +# This Registry file is used to create FAST_Types which contains data used in the FAST glue code. +# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. +# See the NWTC Programmer's Handbook for further information on the format/contents of this file. +# +# Entries are of the form +# +# +# Use ^ as a shortcut for the value in the same column from the previous line. +#---------------------------------------------------------------------------------------------------------------------------------- +include Registry_NWTC_Library.txt + +#---------------------------------------------------------------------------------------------------------------------------------- +# Module Mapping Type (Variable, Load Mesh, Motion Mesh) +#---------------------------------------------------------------------------------------------------------------------------------- + +param Glue - IntKi Map_LoadMesh - 1 - "Load mesh mapping type" - +param ^ - IntKi Map_MotionMesh - 2 - "Motion mesh mapping type" - +param ^ - IntKi Map_Variable - 3 - "Individual variable mapping type" - +param ^ - IntKi Map_Custom - 4 - "Custom mapping not used for linearization" - + +typedef ^ VarMapType IntKi iMapping - 0 - "Mapping index" +typedef ^ ^ IntKi iModSrc - 0 - "Source module index in module array" +typedef ^ ^ IntKi iModDst - 0 - "Destination module index in module array" +typedef ^ ^ IntKi iVarSrc 10 0 - "Source variable indices (Vars%y)" +typedef ^ ^ IntKi iVarSrcDisp 10 0 - "Source variable indices (Vars%u)" +typedef ^ ^ IntKi iVarDst 10 0 - "Destination variable indices (Vars%u)" +typedef ^ ^ IntKi iVarDstDisp 10 0 - "Destination variable indices (Vars%y)" + +typedef ^ ModGlueType character(ChanLen) Name - - - "Glue name" - +typedef ^ ^ ModDataType ModData : - - "Array of module info" - +typedef ^ ^ ModVarsType Vars - - - "Combined module variables" - +typedef ^ ^ ModLinType Lin - - - "Glue linearization data" - +typedef ^ ^ VarMapType VarMaps : - - "Var mapping" + +typedef ^ MappingType character(128) Desc - - - "Description of mapping (used to lookup non-mesh maps)" - +typedef ^ ^ IntKi iModSrc - 0 - "Source module index in ModData array" - +typedef ^ ^ IntKi iModDst - 0 - "Destination module index in ModData array" - +typedef ^ ^ IntKi SrcModID - 0 - "Source module ID" - +typedef ^ ^ IntKi DstModID - 0 - "Destination module ID" - +typedef ^ ^ IntKi SrcIns - 0 - "Source module Instance" - +typedef ^ ^ IntKi DstIns - 0 - "Destination module Instance" - +typedef ^ ^ DatLoc SrcDL - - - "Source mesh locator (number and indices)" - +typedef ^ ^ DatLoc DstDL - - - "Destination mesh locator (number and indices)" - +typedef ^ ^ DatLoc SrcDispDL - - - "Source displacement mesh locator (number and indices)" - +typedef ^ ^ DatLoc DstDispDL - - - "Destination displacement mesh locator (number and indices)" - +typedef ^ ^ IntKi MapType - 0 - "Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Variable, 4=Custom)" - +typedef ^ ^ IntKi XfrType - 0 - "Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L)" - +typedef ^ ^ IntKi XfrTypeAux - 0 - "Integer denoting transfer type to auxiliary mesh (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L)" - +typedef ^ ^ IntKi i - 0 - "Integer for custom mapping index" - +typedef ^ ^ logical Ready - F - "Flag indicating source data is ready to be transferred" - +typedef ^ ^ logical DstUsesSibling - F - "Flag indicating the destination displacement mesh is a sibling of the source destination load mesh" - +typedef ^ ^ R8Ki TmpMatrix :: - - "Temporary matrix for performing transfer for destination load meshes without sibling motion meshes" - +typedef ^ ^ R8Ki VarData : - - "Data array for variable mapping" - +typedef ^ ^ ModVarType SrcVar - - - "Source variable for variable mapping" - +typedef ^ ^ ModVarType DstVar - - - "Destination variable for variable mapping" - +typedef ^ ^ MeshMapType MeshMap - - - "Mesh mapping from Source variable to Destination variable" - +typedef ^ ^ MeshMapType MeshMapAux - - - "Auxiliary mesh mapping for destination load meshes without sibling motion mesh" - +typedef ^ ^ MeshType TmpLoadMesh - - - "Temporary load mesh for intermediate transfers" - +typedef ^ ^ MeshType TmpMotionMesh - - - "Temporary motion mesh for intermediate transfers" - + +#---------------------------------------------------------------------------------------------------------------------------------- +# Glue Parameters +#---------------------------------------------------------------------------------------------------------------------------------- + +typedef ^ Glue_LinParam IntKi NumTimes - - - "Number of times to linearize" - +typedef ^ ^ IntKi InterpOrder - - - "Interpolation order" - +typedef ^ ^ logical SaveOPs - - - "flag to save operating points during linearization" - +typedef ^ ^ IntKi iMod : - - "ModData index order for linearization" - + +typedef ^ Glue_TCParam R8Ki h - - - "solution time step" - +typedef ^ ^ R8Ki ConvTol - - - "Solution convergence tolerance" - +typedef ^ ^ IntKi NumCrctn - - - "" - +typedef ^ ^ IntKi MaxConvIter - - - "" - +typedef ^ ^ IntKi NIter_UJac - - - "Number of solution iterations between updating the Jacobian" - +typedef ^ ^ IntKi NStep_UJac - - - "Number of global time steps between updating the Jacobian" - +typedef ^ ^ R8Ki Scale_UJac - - - "" - +typedef ^ ^ R8Ki RhoInf - - - "Rho infinity used for calculating Generalized-alpha coefficients" - +typedef ^ ^ R8Ki AlphaM - - - "Generalized-alpha alpha_m coefficient" - +typedef ^ ^ R8Ki AlphaF - - - "Generalized-alpha alpha_f coefficient" - +typedef ^ ^ R8Ki Beta - - - "Generalized-alpha beta coefficient" - +typedef ^ ^ R8Ki Gamma - - - "Generalized-alpha gamma coefficient" - +typedef ^ ^ R8Ki BetaPrime - - - "Generalized-alpha beta prime" - +typedef ^ ^ R8Ki GammaPrime - - - "Generalized-alpha gamma prime" - +typedef ^ ^ IntKi NumJ - - - "Number of values in Jacobian" - +typedef ^ ^ IntKi NumQ - - - "Number of states in Jacobian" - +typedef ^ ^ IntKi NumU - - - "Number of total inputs in Jacobian" - +typedef ^ ^ IntKi NumUT - - - "Number of TC inputs in Jacobian" - +typedef ^ ^ IntKi iX1 2 - - "" - +typedef ^ ^ IntKi iX2 2 - - "" - +typedef ^ ^ IntKi iUT 2 - - "" - +typedef ^ ^ IntKi iU1 2 - - "" - +typedef ^ ^ IntKi iUL 2 - - "Input load indices" - +typedef ^ ^ IntKi iyT 2 - - "" - +typedef ^ ^ IntKi iy1 2 - - "" - +typedef ^ ^ IntKi iJX 2 - - "Indices of Jacobian q variables" - +typedef ^ ^ IntKi iJU 2 - - "Indices of Jacobian input variables" - +typedef ^ ^ IntKi iJUT 2 - - "Indices of Jacobian input variables from tight coupling" - +typedef ^ ^ IntKi iJL 2 - - "Indices of Jacobian load variables" - +typedef ^ ^ IntKi iModInit : - - "ModData index order for step 0 initialization" - +typedef ^ ^ IntKi iModTC : - - "ModData index order for tight coupling modules" - +typedef ^ ^ IntKi iModOpt1 : - - "ModData index order for option 1 modules" - +typedef ^ ^ IntKi iModOpt2 : - - "ModData index order for option 2 modules" - +typedef ^ ^ IntKi iModPost : - - "ModData index order for post option 1 modules" - + +typedef ^ Glue_ParameterType Glue_LinParam Lin - - - "Linearization parameters" +typedef ^ ^ Glue_TCParam TC - - - "Tight Coupling solver parameters" + +#---------------------------------------------------------------------------------------------------------------------------------- +# Output Data +#---------------------------------------------------------------------------------------------------------------------------------- + +typedef ^ Glue_LinSave R8Ki Times : - - "linearization times" - +typedef ^ ^ R8Ki u :: - - "linearization operating point input" - +typedef ^ ^ R8Ki x :: - - "linearization operating point continuous state" - +typedef ^ ^ R8Ki xd :: - - "linearization operating point discrete state" - +typedef ^ ^ R8Ki z :: - - "linearization operating point constraint state" - +typedef ^ ^ R8Ki OtherSt :: - - "linearization operating point other state" - + +typedef ^ Glue_OutputFileType Glue_LinSave Lin - - - "Operating point data for linearization" + +#---------------------------------------------------------------------------------------------------------------------------------- +# Miscellaneous Data +#---------------------------------------------------------------------------------------------------------------------------------- + +typedef ^ Glue_CalcSteady R8Ki AzimuthTarget : - - "target azimuth positions where outputs are calculated" - +typedef ^ ^ R8Ki AzimuthDelta - - - "" - +typedef ^ ^ logical IsConverged - - - "Steady State calculation is converged" - +typedef ^ ^ logical FoundSteady - - - "" - +typedef ^ ^ logical ForceLin - - - "" - +typedef ^ ^ IntKi NumRotations - - - "Number of rotor rotations" - +typedef ^ ^ IntKi NumOutputs - - - "Number of output values (ignoring write outputs)" - +typedef ^ ^ R8Ki psi_buffer : - - "azimuth buffer for interpolation" - +typedef ^ ^ R8Ki y_buffer :: - - "output buffer for interpolation" - +typedef ^ ^ R8Ki y_azimuth :: - - "output values at target azimuths" - +typedef ^ ^ R8Ki y_interp : - - "output values interpolated to target azimuth" - +typedef ^ ^ R8Ki y_diff : - - "difference between outputs from current and previous rotation" - +typedef ^ ^ R8Ki y_ref : - - "reference output values for error calculation" - + +typedef ^ AeroMapCase ReKi RotSpeed - - - "Rotor speed for this case of the steady-state solve [>0]" "rad/s" +typedef ^ ^ ReKi TSR - - - "TSR for this case of the steady-state solve [>0]" "-" +typedef ^ ^ ReKi WindSpeed - - - "Windspeed for this case of the steady-state solve [>0]" "m/s" +typedef ^ ^ ReKi Pitch - - - "Pitch angle for this case of the steady-state solve" "rad" + +typedef ^ Glue_AeroMap IntKi iModOrder : - - "Module indices in global ModDataAry" +typedef ^ ^ ModGlueType Mod - - - "Module combining all active modules" - +typedef ^ ^ R8Ki Jac11 :: - - "Components of Jacobian matrix" - +typedef ^ ^ R8Ki Jac12 :: - - "Components of Jacobian matrix" - +typedef ^ ^ R8Ki Jac21 :: - - "Components of Jacobian matrix" - +typedef ^ ^ R8Ki Jac22 :: - - "Components of Jacobian matrix" - +typedef ^ ^ IntKi JacPivot : - - "Jacobian matrix pivot array" - +typedef ^ ^ R8Ki JacScale - - - "Jacobian scaling factor for loads" - +typedef ^ ^ R8Ki SolveTolerance - - - "Allowable solution tolerance" - +typedef ^ ^ R8Ki HubOrientation ::: - - "Hub orientation matrix for each blade" - +typedef ^ ^ R8Ki u1 : - - "" - +typedef ^ ^ R8Ki u2 : - - "" - +typedef ^ ^ R8Ki Residual : - - "" - +typedef ^ ^ R8Ki SolveDelta : - - "" - +typedef ^ ^ AeroMapCase Cases : - - "cases to run for aero mapping" - +typedef ^ ^ IntKi LinFileNum - 1 - "Linearization file number" - + +typedef ^ TC_State R8Ki q_prev : - - "Generalized alpha previous step displacement" - +typedef ^ ^ R8Ki x : - - "Generalized alpha change in displacement" - +typedef ^ ^ R8Ki q : - - "Generalized alpha predicted displacement" - +typedef ^ ^ R8Ki v : - - "Generalized alpha velocities" - +typedef ^ ^ R8Ki vd : - - "Generalized alpha acceleration" - +typedef ^ ^ R8Ki a : - - "Generalized alpha algorithmic acceleration" - + +typedef ^ Glue_TCMisc ModGlueType Mod - - - "Glue module combining tight coupling modules" - +typedef ^ ^ TC_State StateCurr - - - "Tight Coupling current state" +typedef ^ ^ TC_State StatePred - - - "Tight Coupling predicted state" +typedef ^ ^ R8Ki UCalc : - - "" - +typedef ^ ^ R8Ki XB :: - - "" - +typedef ^ ^ IntKi IPIV : - - "" - +typedef ^ ^ IntKi IterTotal - 0 - "" - +typedef ^ ^ IntKi UJacIterRemain - 0 - "Number of convergence iterations until Jacobian update" - +typedef ^ ^ IntKi UJacStepsRemain - 0 - "Number of time steps until Jacobian update" - +typedef ^ ^ logical ConvWarn - - - "Flag to warn about convergence failure" - +typedef ^ ^ R8Ki XB_IO :: - - "" - +typedef ^ ^ R8Ki Jac_IO :: - - "" - +typedef ^ ^ R8Ki J11 :: - - "Jacobian upper left quadrant" - +typedef ^ ^ R8Ki J12 :: - - "Jacobian upper right quadrant" - +typedef ^ ^ R8Ki J21 :: - - "Jacobian lower left quadrant" - +typedef ^ ^ R8Ki J22 :: - - "Jacobian lower right quadrant" - + +typedef ^ Glue_LinMisc IntKi TimeIndex - - - "" - +typedef ^ ^ IntKi AzimuthIndex - - - "" - +typedef ^ ^ logical IsConverged - - - "" - + +typedef ^ Glue_MiscVarType ModDataType ModData : - - "Module variable and value data" - +typedef ^ ^ MappingType Mappings : - - "Module mapping" - +typedef ^ ^ ModGlueType ModGlue - - - "Glue code module" - +typedef ^ ^ Glue_LinMisc Lin - - - "Linearization misc vars" +typedef ^ ^ Glue_CalcSteady CS - - - "CalcSteady calculation data" +typedef ^ ^ Glue_AeroMap AM - - - "AeroMap data" +typedef ^ ^ Glue_TCMisc TC - - - "Tight Coupling Miscellaneous data" diff --git a/modules/openfast-library/src/Glue_Types.f90 b/modules/openfast-library/src/Glue_Types.f90 new file mode 100644 index 0000000000..a10c7f76e6 --- /dev/null +++ b/modules/openfast-library/src/Glue_Types.f90 @@ -0,0 +1,2291 @@ +!STARTOFREGISTRYGENERATEDFILE 'Glue_Types.f90' +! +! WARNING This file is generated automatically by the FAST registry. +! Do not edit. Your changes to this file will be lost. +! +! FAST Registry +!********************************************************************************************************************************* +! Glue_Types +!................................................................................................................................. +! This file is part of Glue. +! +! Copyright (C) 2012-2016 National Renewable Energy Laboratory +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +! +! +! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost. +! +!********************************************************************************************************************************* +!> This module contains the user-defined types needed in Glue. 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 Glue_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE NWTC_Library +IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: Map_LoadMesh = 1 ! Load mesh mapping type [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Map_MotionMesh = 2 ! Motion mesh mapping type [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Map_Variable = 3 ! Individual variable mapping type [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Map_Custom = 4 ! Custom mapping not used for linearization [-] +! ========= VarMapType ======= + TYPE, PUBLIC :: VarMapType + INTEGER(IntKi) :: iMapping = 0 !< Mapping index [-] + INTEGER(IntKi) :: iModSrc = 0 !< Source module index in module array [-] + INTEGER(IntKi) :: iModDst = 0 !< Destination module index in module array [-] + INTEGER(IntKi) , DIMENSION(1:10) :: iVarSrc = 0 !< Source variable indices (Vars%y) [-] + INTEGER(IntKi) , DIMENSION(1:10) :: iVarSrcDisp = 0 !< Source variable indices (Vars%u) [-] + INTEGER(IntKi) , DIMENSION(1:10) :: iVarDst = 0 !< Destination variable indices (Vars%u) [-] + INTEGER(IntKi) , DIMENSION(1:10) :: iVarDstDisp = 0 !< Destination variable indices (Vars%y) [-] + END TYPE VarMapType +! ======================= +! ========= ModGlueType ======= + TYPE, PUBLIC :: ModGlueType + character(ChanLen) :: Name !< Glue name [-] + TYPE(ModDataType) , DIMENSION(:), ALLOCATABLE :: ModData !< Array of module info [-] + TYPE(ModVarsType) :: Vars !< Combined module variables [-] + TYPE(ModLinType) :: Lin !< Glue linearization data [-] + TYPE(VarMapType) , DIMENSION(:), ALLOCATABLE :: VarMaps !< Var mapping [-] + END TYPE ModGlueType +! ======================= +! ========= MappingType ======= + TYPE, PUBLIC :: MappingType + character(128) :: Desc !< Description of mapping (used to lookup non-mesh maps) [-] + INTEGER(IntKi) :: iModSrc = 0 !< Source module index in ModData array [-] + INTEGER(IntKi) :: iModDst = 0 !< Destination module index in ModData array [-] + INTEGER(IntKi) :: SrcModID = 0 !< Source module ID [-] + INTEGER(IntKi) :: DstModID = 0 !< Destination module ID [-] + INTEGER(IntKi) :: SrcIns = 0 !< Source module Instance [-] + INTEGER(IntKi) :: DstIns = 0 !< Destination module Instance [-] + TYPE(DatLoc) :: SrcDL !< Source mesh locator (number and indices) [-] + TYPE(DatLoc) :: DstDL !< Destination mesh locator (number and indices) [-] + TYPE(DatLoc) :: SrcDispDL !< Source displacement mesh locator (number and indices) [-] + TYPE(DatLoc) :: DstDispDL !< Destination displacement mesh locator (number and indices) [-] + INTEGER(IntKi) :: MapType = 0 !< Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Variable, 4=Custom) [-] + INTEGER(IntKi) :: XfrType = 0 !< Integer denoting transfer type (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L) [-] + INTEGER(IntKi) :: XfrTypeAux = 0 !< Integer denoting transfer type to auxiliary mesh (1=P-to-P, 2=L-to-P, 3=P-to-L, 4=L-to-L) [-] + INTEGER(IntKi) :: i = 0 !< Integer for custom mapping index [-] + LOGICAL :: Ready = .false. !< Flag indicating source data is ready to be transferred [-] + LOGICAL :: DstUsesSibling = .false. !< Flag indicating the destination displacement mesh is a sibling of the source destination load mesh [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: TmpMatrix !< Temporary matrix for performing transfer for destination load meshes without sibling motion meshes [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: VarData !< Data array for variable mapping [-] + TYPE(ModVarType) :: SrcVar !< Source variable for variable mapping [-] + TYPE(ModVarType) :: DstVar !< Destination variable for variable mapping [-] + TYPE(MeshMapType) :: MeshMap !< Mesh mapping from Source variable to Destination variable [-] + TYPE(MeshMapType) :: MeshMapAux !< Auxiliary mesh mapping for destination load meshes without sibling motion mesh [-] + TYPE(MeshType) :: TmpLoadMesh !< Temporary load mesh for intermediate transfers [-] + TYPE(MeshType) :: TmpMotionMesh !< Temporary motion mesh for intermediate transfers [-] + END TYPE MappingType +! ======================= +! ========= Glue_LinParam ======= + TYPE, PUBLIC :: Glue_LinParam + INTEGER(IntKi) :: NumTimes = 0_IntKi !< Number of times to linearize [-] + INTEGER(IntKi) :: InterpOrder = 0_IntKi !< Interpolation order [-] + LOGICAL :: SaveOPs = .false. !< flag to save operating points during linearization [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iMod !< ModData index order for linearization [-] + END TYPE Glue_LinParam +! ======================= +! ========= Glue_TCParam ======= + TYPE, PUBLIC :: Glue_TCParam + REAL(R8Ki) :: h = 0.0_R8Ki !< solution time step [-] + REAL(R8Ki) :: ConvTol = 0.0_R8Ki !< Solution convergence tolerance [-] + INTEGER(IntKi) :: NumCrctn = 0_IntKi !< [-] + INTEGER(IntKi) :: MaxConvIter = 0_IntKi !< [-] + INTEGER(IntKi) :: NIter_UJac = 0_IntKi !< Number of solution iterations between updating the Jacobian [-] + INTEGER(IntKi) :: NStep_UJac = 0_IntKi !< Number of global time steps between updating the Jacobian [-] + REAL(R8Ki) :: Scale_UJac = 0.0_R8Ki !< [-] + REAL(R8Ki) :: RhoInf = 0.0_R8Ki !< Rho infinity used for calculating Generalized-alpha coefficients [-] + REAL(R8Ki) :: AlphaM = 0.0_R8Ki !< Generalized-alpha alpha_m coefficient [-] + REAL(R8Ki) :: AlphaF = 0.0_R8Ki !< Generalized-alpha alpha_f coefficient [-] + REAL(R8Ki) :: Beta = 0.0_R8Ki !< Generalized-alpha beta coefficient [-] + REAL(R8Ki) :: Gamma = 0.0_R8Ki !< Generalized-alpha gamma coefficient [-] + REAL(R8Ki) :: BetaPrime = 0.0_R8Ki !< Generalized-alpha beta prime [-] + REAL(R8Ki) :: GammaPrime = 0.0_R8Ki !< Generalized-alpha gamma prime [-] + INTEGER(IntKi) :: NumJ = 0_IntKi !< Number of values in Jacobian [-] + INTEGER(IntKi) :: NumQ = 0_IntKi !< Number of states in Jacobian [-] + INTEGER(IntKi) :: NumU = 0_IntKi !< Number of total inputs in Jacobian [-] + INTEGER(IntKi) :: NumUT = 0_IntKi !< Number of TC inputs in Jacobian [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iX1 = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iX2 = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iUT = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iU1 = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iUL = 0_IntKi !< Input load indices [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iyT = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iy1 = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iJX = 0_IntKi !< Indices of Jacobian q variables [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iJU = 0_IntKi !< Indices of Jacobian input variables [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iJUT = 0_IntKi !< Indices of Jacobian input variables from tight coupling [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iJL = 0_IntKi !< Indices of Jacobian load variables [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModInit !< ModData index order for step 0 initialization [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModTC !< ModData index order for tight coupling modules [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt1 !< ModData index order for option 1 modules [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt2 !< ModData index order for option 2 modules [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModPost !< ModData index order for post option 1 modules [-] + END TYPE Glue_TCParam +! ======================= +! ========= Glue_ParameterType ======= + TYPE, PUBLIC :: Glue_ParameterType + TYPE(Glue_LinParam) :: Lin !< Linearization parameters [-] + TYPE(Glue_TCParam) :: TC !< Tight Coupling solver parameters [-] + END TYPE Glue_ParameterType +! ======================= +! ========= Glue_LinSave ======= + TYPE, PUBLIC :: Glue_LinSave + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: Times !< linearization times [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: u !< linearization operating point input [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: x !< linearization operating point continuous state [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: xd !< linearization operating point discrete state [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: z !< linearization operating point constraint state [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: OtherSt !< linearization operating point other state [-] + END TYPE Glue_LinSave +! ======================= +! ========= Glue_OutputFileType ======= + TYPE, PUBLIC :: Glue_OutputFileType + TYPE(Glue_LinSave) :: Lin !< Operating point data for linearization [-] + END TYPE Glue_OutputFileType +! ======================= +! ========= Glue_CalcSteady ======= + TYPE, PUBLIC :: Glue_CalcSteady + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: AzimuthTarget !< target azimuth positions where outputs are calculated [-] + REAL(R8Ki) :: AzimuthDelta = 0.0_R8Ki !< [-] + LOGICAL :: IsConverged = .false. !< Steady State calculation is converged [-] + LOGICAL :: FoundSteady = .false. !< [-] + LOGICAL :: ForceLin = .false. !< [-] + INTEGER(IntKi) :: NumRotations = 0_IntKi !< Number of rotor rotations [-] + INTEGER(IntKi) :: NumOutputs = 0_IntKi !< Number of output values (ignoring write outputs) [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: psi_buffer !< azimuth buffer for interpolation [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: y_buffer !< output buffer for interpolation [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: y_azimuth !< output values at target azimuths [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_interp !< output values interpolated to target azimuth [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_diff !< difference between outputs from current and previous rotation [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y_ref !< reference output values for error calculation [-] + END TYPE Glue_CalcSteady +! ======================= +! ========= AeroMapCase ======= + TYPE, PUBLIC :: AeroMapCase + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Rotor speed for this case of the steady-state solve [>0] [rad/s] + REAL(ReKi) :: TSR = 0.0_ReKi !< TSR for this case of the steady-state solve [>0] [-] + REAL(ReKi) :: WindSpeed = 0.0_ReKi !< Windspeed for this case of the steady-state solve [>0] [m/s] + REAL(ReKi) :: Pitch = 0.0_ReKi !< Pitch angle for this case of the steady-state solve [rad] + END TYPE AeroMapCase +! ======================= +! ========= Glue_AeroMap ======= + TYPE, PUBLIC :: Glue_AeroMap + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOrder !< Module indices in global ModDataAry [-] + TYPE(ModGlueType) :: Mod !< Module combining all active modules [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac11 !< Components of Jacobian matrix [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac12 !< Components of Jacobian matrix [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac21 !< Components of Jacobian matrix [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac22 !< Components of Jacobian matrix [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: JacPivot !< Jacobian matrix pivot array [-] + REAL(R8Ki) :: JacScale = 0.0_R8Ki !< Jacobian scaling factor for loads [-] + REAL(R8Ki) :: SolveTolerance = 0.0_R8Ki !< Allowable solution tolerance [-] + REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: HubOrientation !< Hub orientation matrix for each blade [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u1 !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u2 !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: Residual !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: SolveDelta !< [-] + TYPE(AeroMapCase) , DIMENSION(:), ALLOCATABLE :: Cases !< cases to run for aero mapping [-] + INTEGER(IntKi) :: LinFileNum = 1 !< Linearization file number [-] + END TYPE Glue_AeroMap +! ======================= +! ========= TC_State ======= + TYPE, PUBLIC :: TC_State + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: q_prev !< Generalized alpha previous step displacement [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< Generalized alpha change in displacement [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: q !< Generalized alpha predicted displacement [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: v !< Generalized alpha velocities [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: vd !< Generalized alpha acceleration [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: a !< Generalized alpha algorithmic acceleration [-] + END TYPE TC_State +! ======================= +! ========= Glue_TCMisc ======= + TYPE, PUBLIC :: Glue_TCMisc + TYPE(ModGlueType) :: Mod !< Glue module combining tight coupling modules [-] + TYPE(TC_State) :: StateCurr !< Tight Coupling current state [-] + TYPE(TC_State) :: StatePred !< Tight Coupling predicted state [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: UCalc !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: XB !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IPIV !< [-] + INTEGER(IntKi) :: IterTotal = 0 !< [-] + INTEGER(IntKi) :: UJacIterRemain = 0 !< Number of convergence iterations until Jacobian update [-] + INTEGER(IntKi) :: UJacStepsRemain = 0 !< Number of time steps until Jacobian update [-] + LOGICAL :: ConvWarn = .false. !< Flag to warn about convergence failure [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: XB_IO !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac_IO !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: J11 !< Jacobian upper left quadrant [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: J12 !< Jacobian upper right quadrant [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: J21 !< Jacobian lower left quadrant [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: J22 !< Jacobian lower right quadrant [-] + END TYPE Glue_TCMisc +! ======================= +! ========= Glue_LinMisc ======= + TYPE, PUBLIC :: Glue_LinMisc + INTEGER(IntKi) :: TimeIndex = 0_IntKi !< [-] + INTEGER(IntKi) :: AzimuthIndex = 0_IntKi !< [-] + LOGICAL :: IsConverged = .false. !< [-] + END TYPE Glue_LinMisc +! ======================= +! ========= Glue_MiscVarType ======= + TYPE, PUBLIC :: Glue_MiscVarType + TYPE(ModDataType) , DIMENSION(:), ALLOCATABLE :: ModData !< Module variable and value data [-] + TYPE(MappingType) , DIMENSION(:), ALLOCATABLE :: Mappings !< Module mapping [-] + TYPE(ModGlueType) :: ModGlue !< Glue code module [-] + TYPE(Glue_LinMisc) :: Lin !< Linearization misc vars [-] + TYPE(Glue_CalcSteady) :: CS !< CalcSteady calculation data [-] + TYPE(Glue_AeroMap) :: AM !< AeroMap data [-] + TYPE(Glue_TCMisc) :: TC !< Tight Coupling Miscellaneous data [-] + END TYPE Glue_MiscVarType +! ======================= + +contains + +subroutine Glue_CopyVarMapType(SrcVarMapTypeData, DstVarMapTypeData, CtrlCode, ErrStat, ErrMsg) + type(VarMapType), intent(in) :: SrcVarMapTypeData + type(VarMapType), intent(inout) :: DstVarMapTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_CopyVarMapType' + ErrStat = ErrID_None + ErrMsg = '' + DstVarMapTypeData%iMapping = SrcVarMapTypeData%iMapping + DstVarMapTypeData%iModSrc = SrcVarMapTypeData%iModSrc + DstVarMapTypeData%iModDst = SrcVarMapTypeData%iModDst + DstVarMapTypeData%iVarSrc = SrcVarMapTypeData%iVarSrc + DstVarMapTypeData%iVarSrcDisp = SrcVarMapTypeData%iVarSrcDisp + DstVarMapTypeData%iVarDst = SrcVarMapTypeData%iVarDst + DstVarMapTypeData%iVarDstDisp = SrcVarMapTypeData%iVarDstDisp +end subroutine + +subroutine Glue_DestroyVarMapType(VarMapTypeData, ErrStat, ErrMsg) + type(VarMapType), intent(inout) :: VarMapTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_DestroyVarMapType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Glue_PackVarMapType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(VarMapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackVarMapType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%iMapping) + call RegPack(RF, InData%iModSrc) + call RegPack(RF, InData%iModDst) + call RegPack(RF, InData%iVarSrc) + call RegPack(RF, InData%iVarSrcDisp) + call RegPack(RF, InData%iVarDst) + call RegPack(RF, InData%iVarDstDisp) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackVarMapType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(VarMapType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackVarMapType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%iMapping); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iModSrc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iModDst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarSrc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarSrcDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarDstDisp); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_CopyModGlueType(SrcModGlueTypeData, DstModGlueTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModGlueType), intent(in) :: SrcModGlueTypeData + type(ModGlueType), intent(inout) :: DstModGlueTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_CopyModGlueType' + ErrStat = ErrID_None + ErrMsg = '' + DstModGlueTypeData%Name = SrcModGlueTypeData%Name + if (allocated(SrcModGlueTypeData%ModData)) then + LB(1:1) = lbound(SrcModGlueTypeData%ModData) + UB(1:1) = ubound(SrcModGlueTypeData%ModData) + if (.not. allocated(DstModGlueTypeData%ModData)) then + allocate(DstModGlueTypeData%ModData(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModGlueTypeData%ModData.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyModDataType(SrcModGlueTypeData%ModData(i1), DstModGlueTypeData%ModData(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call NWTC_Library_CopyModVarsType(SrcModGlueTypeData%Vars, DstModGlueTypeData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyModLinType(SrcModGlueTypeData%Lin, DstModGlueTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModGlueTypeData%VarMaps)) then + LB(1:1) = lbound(SrcModGlueTypeData%VarMaps) + UB(1:1) = ubound(SrcModGlueTypeData%VarMaps) + if (.not. allocated(DstModGlueTypeData%VarMaps)) then + allocate(DstModGlueTypeData%VarMaps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModGlueTypeData%VarMaps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Glue_CopyVarMapType(SrcModGlueTypeData%VarMaps(i1), DstModGlueTypeData%VarMaps(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine Glue_DestroyModGlueType(ModGlueTypeData, ErrStat, ErrMsg) + type(ModGlueType), intent(inout) :: ModGlueTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_DestroyModGlueType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModGlueTypeData%ModData)) then + LB(1:1) = lbound(ModGlueTypeData%ModData) + UB(1:1) = ubound(ModGlueTypeData%ModData) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyModDataType(ModGlueTypeData%ModData(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModGlueTypeData%ModData) + end if + call NWTC_Library_DestroyModVarsType(ModGlueTypeData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModLinType(ModGlueTypeData%Lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ModGlueTypeData%VarMaps)) then + LB(1:1) = lbound(ModGlueTypeData%VarMaps) + UB(1:1) = ubound(ModGlueTypeData%VarMaps) + do i1 = LB(1), UB(1) + call Glue_DestroyVarMapType(ModGlueTypeData%VarMaps(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModGlueTypeData%VarMaps) + end if +end subroutine + +subroutine Glue_PackModGlueType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ModGlueType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackModGlueType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Name) + call RegPack(RF, allocated(InData%ModData)) + if (allocated(InData%ModData)) then + call RegPackBounds(RF, 1, lbound(InData%ModData), ubound(InData%ModData)) + LB(1:1) = lbound(InData%ModData) + UB(1:1) = ubound(InData%ModData) + do i1 = LB(1), UB(1) + call NWTC_Library_PackModDataType(RF, InData%ModData(i1)) + end do + end if + call NWTC_Library_PackModVarsType(RF, InData%Vars) + call NWTC_Library_PackModLinType(RF, InData%Lin) + call RegPack(RF, allocated(InData%VarMaps)) + if (allocated(InData%VarMaps)) then + call RegPackBounds(RF, 1, lbound(InData%VarMaps), ubound(InData%VarMaps)) + LB(1:1) = lbound(InData%VarMaps) + UB(1:1) = ubound(InData%VarMaps) + do i1 = LB(1), UB(1) + call Glue_PackVarMapType(RF, InData%VarMaps(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackModGlueType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ModGlueType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackModGlueType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Name); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%ModData)) deallocate(OutData%ModData) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%ModData(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ModData.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackModDataType(RF, OutData%ModData(i1)) ! ModData + end do + end if + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + call NWTC_Library_UnpackModLinType(RF, OutData%Lin) ! Lin + if (allocated(OutData%VarMaps)) deallocate(OutData%VarMaps) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%VarMaps(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VarMaps.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Glue_UnpackVarMapType(RF, OutData%VarMaps(i1)) ! VarMaps + end do + end if +end subroutine + +subroutine Glue_CopyMappingType(SrcMappingTypeData, DstMappingTypeData, CtrlCode, ErrStat, ErrMsg) + type(MappingType), intent(inout) :: SrcMappingTypeData + type(MappingType), intent(inout) :: DstMappingTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_CopyMappingType' + ErrStat = ErrID_None + ErrMsg = '' + DstMappingTypeData%Desc = SrcMappingTypeData%Desc + DstMappingTypeData%iModSrc = SrcMappingTypeData%iModSrc + DstMappingTypeData%iModDst = SrcMappingTypeData%iModDst + DstMappingTypeData%SrcModID = SrcMappingTypeData%SrcModID + DstMappingTypeData%DstModID = SrcMappingTypeData%DstModID + DstMappingTypeData%SrcIns = SrcMappingTypeData%SrcIns + DstMappingTypeData%DstIns = SrcMappingTypeData%DstIns + call NWTC_Library_CopyDatLoc(SrcMappingTypeData%SrcDL, DstMappingTypeData%SrcDL, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyDatLoc(SrcMappingTypeData%DstDL, DstMappingTypeData%DstDL, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyDatLoc(SrcMappingTypeData%SrcDispDL, DstMappingTypeData%SrcDispDL, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyDatLoc(SrcMappingTypeData%DstDispDL, DstMappingTypeData%DstDispDL, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMappingTypeData%MapType = SrcMappingTypeData%MapType + DstMappingTypeData%XfrType = SrcMappingTypeData%XfrType + DstMappingTypeData%XfrTypeAux = SrcMappingTypeData%XfrTypeAux + DstMappingTypeData%i = SrcMappingTypeData%i + DstMappingTypeData%Ready = SrcMappingTypeData%Ready + DstMappingTypeData%DstUsesSibling = SrcMappingTypeData%DstUsesSibling + if (allocated(SrcMappingTypeData%TmpMatrix)) then + LB(1:2) = lbound(SrcMappingTypeData%TmpMatrix) + UB(1:2) = ubound(SrcMappingTypeData%TmpMatrix) + if (.not. allocated(DstMappingTypeData%TmpMatrix)) then + allocate(DstMappingTypeData%TmpMatrix(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMappingTypeData%TmpMatrix.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMappingTypeData%TmpMatrix = SrcMappingTypeData%TmpMatrix + end if + if (allocated(SrcMappingTypeData%VarData)) then + LB(1:1) = lbound(SrcMappingTypeData%VarData) + UB(1:1) = ubound(SrcMappingTypeData%VarData) + if (.not. allocated(DstMappingTypeData%VarData)) then + allocate(DstMappingTypeData%VarData(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMappingTypeData%VarData.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMappingTypeData%VarData = SrcMappingTypeData%VarData + end if + call NWTC_Library_CopyModVarType(SrcMappingTypeData%SrcVar, DstMappingTypeData%SrcVar, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyModVarType(SrcMappingTypeData%DstVar, DstMappingTypeData%DstVar, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcMappingTypeData%MeshMap, DstMappingTypeData%MeshMap, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcMappingTypeData%MeshMapAux, DstMappingTypeData%MeshMapAux, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcMappingTypeData%TmpLoadMesh, DstMappingTypeData%TmpLoadMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcMappingTypeData%TmpMotionMesh, DstMappingTypeData%TmpMotionMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine Glue_DestroyMappingType(MappingTypeData, ErrStat, ErrMsg) + type(MappingType), intent(inout) :: MappingTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_DestroyMappingType' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyDatLoc(MappingTypeData%SrcDL, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyDatLoc(MappingTypeData%DstDL, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyDatLoc(MappingTypeData%SrcDispDL, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyDatLoc(MappingTypeData%DstDispDL, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MappingTypeData%TmpMatrix)) then + deallocate(MappingTypeData%TmpMatrix) + end if + if (allocated(MappingTypeData%VarData)) then + deallocate(MappingTypeData%VarData) + end if + call NWTC_Library_DestroyModVarType(MappingTypeData%SrcVar, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModVarType(MappingTypeData%DstVar, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(MappingTypeData%MeshMap, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(MappingTypeData%MeshMapAux, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( MappingTypeData%TmpLoadMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( MappingTypeData%TmpMotionMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Glue_PackMappingType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MappingType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackMappingType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Desc) + call RegPack(RF, InData%iModSrc) + call RegPack(RF, InData%iModDst) + call RegPack(RF, InData%SrcModID) + call RegPack(RF, InData%DstModID) + call RegPack(RF, InData%SrcIns) + call RegPack(RF, InData%DstIns) + call NWTC_Library_PackDatLoc(RF, InData%SrcDL) + call NWTC_Library_PackDatLoc(RF, InData%DstDL) + call NWTC_Library_PackDatLoc(RF, InData%SrcDispDL) + call NWTC_Library_PackDatLoc(RF, InData%DstDispDL) + call RegPack(RF, InData%MapType) + call RegPack(RF, InData%XfrType) + call RegPack(RF, InData%XfrTypeAux) + call RegPack(RF, InData%i) + call RegPack(RF, InData%Ready) + call RegPack(RF, InData%DstUsesSibling) + call RegPackAlloc(RF, InData%TmpMatrix) + call RegPackAlloc(RF, InData%VarData) + call NWTC_Library_PackModVarType(RF, InData%SrcVar) + call NWTC_Library_PackModVarType(RF, InData%DstVar) + call NWTC_Library_PackMeshMapType(RF, InData%MeshMap) + call NWTC_Library_PackMeshMapType(RF, InData%MeshMapAux) + call MeshPack(RF, InData%TmpLoadMesh) + call MeshPack(RF, InData%TmpMotionMesh) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackMappingType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MappingType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackMappingType' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Desc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iModSrc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iModDst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SrcModID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DstModID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SrcIns); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DstIns); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackDatLoc(RF, OutData%SrcDL) ! SrcDL + call NWTC_Library_UnpackDatLoc(RF, OutData%DstDL) ! DstDL + call NWTC_Library_UnpackDatLoc(RF, OutData%SrcDispDL) ! SrcDispDL + call NWTC_Library_UnpackDatLoc(RF, OutData%DstDispDL) ! DstDispDL + call RegUnpack(RF, OutData%MapType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%XfrType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%XfrTypeAux); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ready); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DstUsesSibling); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TmpMatrix); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VarData); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModVarType(RF, OutData%SrcVar) ! SrcVar + call NWTC_Library_UnpackModVarType(RF, OutData%DstVar) ! DstVar + call NWTC_Library_UnpackMeshMapType(RF, OutData%MeshMap) ! MeshMap + call NWTC_Library_UnpackMeshMapType(RF, OutData%MeshMapAux) ! MeshMapAux + call MeshUnpack(RF, OutData%TmpLoadMesh) ! TmpLoadMesh + call MeshUnpack(RF, OutData%TmpMotionMesh) ! TmpMotionMesh +end subroutine + +subroutine Glue_CopyLinParam(SrcLinParamData, DstLinParamData, CtrlCode, ErrStat, ErrMsg) + type(Glue_LinParam), intent(in) :: SrcLinParamData + type(Glue_LinParam), intent(inout) :: DstLinParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Glue_CopyLinParam' + ErrStat = ErrID_None + ErrMsg = '' + DstLinParamData%NumTimes = SrcLinParamData%NumTimes + DstLinParamData%InterpOrder = SrcLinParamData%InterpOrder + DstLinParamData%SaveOPs = SrcLinParamData%SaveOPs + if (allocated(SrcLinParamData%iMod)) then + LB(1:1) = lbound(SrcLinParamData%iMod) + UB(1:1) = ubound(SrcLinParamData%iMod) + if (.not. allocated(DstLinParamData%iMod)) then + allocate(DstLinParamData%iMod(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinParamData%iMod.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinParamData%iMod = SrcLinParamData%iMod + end if +end subroutine + +subroutine Glue_DestroyLinParam(LinParamData, ErrStat, ErrMsg) + type(Glue_LinParam), intent(inout) :: LinParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_DestroyLinParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(LinParamData%iMod)) then + deallocate(LinParamData%iMod) + end if +end subroutine + +subroutine Glue_PackLinParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Glue_LinParam), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackLinParam' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumTimes) + call RegPack(RF, InData%InterpOrder) + call RegPack(RF, InData%SaveOPs) + call RegPackAlloc(RF, InData%iMod) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackLinParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Glue_LinParam), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackLinParam' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InterpOrder); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SaveOPs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iMod); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_CopyTCParam(SrcTCParamData, DstTCParamData, CtrlCode, ErrStat, ErrMsg) + type(Glue_TCParam), intent(in) :: SrcTCParamData + type(Glue_TCParam), intent(inout) :: DstTCParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Glue_CopyTCParam' + ErrStat = ErrID_None + ErrMsg = '' + DstTCParamData%h = SrcTCParamData%h + DstTCParamData%ConvTol = SrcTCParamData%ConvTol + DstTCParamData%NumCrctn = SrcTCParamData%NumCrctn + DstTCParamData%MaxConvIter = SrcTCParamData%MaxConvIter + DstTCParamData%NIter_UJac = SrcTCParamData%NIter_UJac + DstTCParamData%NStep_UJac = SrcTCParamData%NStep_UJac + DstTCParamData%Scale_UJac = SrcTCParamData%Scale_UJac + DstTCParamData%RhoInf = SrcTCParamData%RhoInf + DstTCParamData%AlphaM = SrcTCParamData%AlphaM + DstTCParamData%AlphaF = SrcTCParamData%AlphaF + DstTCParamData%Beta = SrcTCParamData%Beta + DstTCParamData%Gamma = SrcTCParamData%Gamma + DstTCParamData%BetaPrime = SrcTCParamData%BetaPrime + DstTCParamData%GammaPrime = SrcTCParamData%GammaPrime + DstTCParamData%NumJ = SrcTCParamData%NumJ + DstTCParamData%NumQ = SrcTCParamData%NumQ + DstTCParamData%NumU = SrcTCParamData%NumU + DstTCParamData%NumUT = SrcTCParamData%NumUT + DstTCParamData%iX1 = SrcTCParamData%iX1 + DstTCParamData%iX2 = SrcTCParamData%iX2 + DstTCParamData%iUT = SrcTCParamData%iUT + DstTCParamData%iU1 = SrcTCParamData%iU1 + DstTCParamData%iUL = SrcTCParamData%iUL + DstTCParamData%iyT = SrcTCParamData%iyT + DstTCParamData%iy1 = SrcTCParamData%iy1 + DstTCParamData%iJX = SrcTCParamData%iJX + DstTCParamData%iJU = SrcTCParamData%iJU + DstTCParamData%iJUT = SrcTCParamData%iJUT + DstTCParamData%iJL = SrcTCParamData%iJL + if (allocated(SrcTCParamData%iModInit)) then + LB(1:1) = lbound(SrcTCParamData%iModInit) + UB(1:1) = ubound(SrcTCParamData%iModInit) + if (.not. allocated(DstTCParamData%iModInit)) then + allocate(DstTCParamData%iModInit(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCParamData%iModInit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCParamData%iModInit = SrcTCParamData%iModInit + end if + if (allocated(SrcTCParamData%iModTC)) then + LB(1:1) = lbound(SrcTCParamData%iModTC) + UB(1:1) = ubound(SrcTCParamData%iModTC) + if (.not. allocated(DstTCParamData%iModTC)) then + allocate(DstTCParamData%iModTC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCParamData%iModTC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCParamData%iModTC = SrcTCParamData%iModTC + end if + if (allocated(SrcTCParamData%iModOpt1)) then + LB(1:1) = lbound(SrcTCParamData%iModOpt1) + UB(1:1) = ubound(SrcTCParamData%iModOpt1) + if (.not. allocated(DstTCParamData%iModOpt1)) then + allocate(DstTCParamData%iModOpt1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCParamData%iModOpt1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCParamData%iModOpt1 = SrcTCParamData%iModOpt1 + end if + if (allocated(SrcTCParamData%iModOpt2)) then + LB(1:1) = lbound(SrcTCParamData%iModOpt2) + UB(1:1) = ubound(SrcTCParamData%iModOpt2) + if (.not. allocated(DstTCParamData%iModOpt2)) then + allocate(DstTCParamData%iModOpt2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCParamData%iModOpt2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCParamData%iModOpt2 = SrcTCParamData%iModOpt2 + end if + if (allocated(SrcTCParamData%iModPost)) then + LB(1:1) = lbound(SrcTCParamData%iModPost) + UB(1:1) = ubound(SrcTCParamData%iModPost) + if (.not. allocated(DstTCParamData%iModPost)) then + allocate(DstTCParamData%iModPost(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCParamData%iModPost.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCParamData%iModPost = SrcTCParamData%iModPost + end if +end subroutine + +subroutine Glue_DestroyTCParam(TCParamData, ErrStat, ErrMsg) + type(Glue_TCParam), intent(inout) :: TCParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_DestroyTCParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(TCParamData%iModInit)) then + deallocate(TCParamData%iModInit) + end if + if (allocated(TCParamData%iModTC)) then + deallocate(TCParamData%iModTC) + end if + if (allocated(TCParamData%iModOpt1)) then + deallocate(TCParamData%iModOpt1) + end if + if (allocated(TCParamData%iModOpt2)) then + deallocate(TCParamData%iModOpt2) + end if + if (allocated(TCParamData%iModPost)) then + deallocate(TCParamData%iModPost) + end if +end subroutine + +subroutine Glue_PackTCParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Glue_TCParam), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackTCParam' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%h) + call RegPack(RF, InData%ConvTol) + call RegPack(RF, InData%NumCrctn) + call RegPack(RF, InData%MaxConvIter) + call RegPack(RF, InData%NIter_UJac) + call RegPack(RF, InData%NStep_UJac) + call RegPack(RF, InData%Scale_UJac) + call RegPack(RF, InData%RhoInf) + call RegPack(RF, InData%AlphaM) + call RegPack(RF, InData%AlphaF) + call RegPack(RF, InData%Beta) + call RegPack(RF, InData%Gamma) + call RegPack(RF, InData%BetaPrime) + call RegPack(RF, InData%GammaPrime) + call RegPack(RF, InData%NumJ) + call RegPack(RF, InData%NumQ) + call RegPack(RF, InData%NumU) + call RegPack(RF, InData%NumUT) + call RegPack(RF, InData%iX1) + call RegPack(RF, InData%iX2) + call RegPack(RF, InData%iUT) + call RegPack(RF, InData%iU1) + call RegPack(RF, InData%iUL) + call RegPack(RF, InData%iyT) + call RegPack(RF, InData%iy1) + call RegPack(RF, InData%iJX) + call RegPack(RF, InData%iJU) + call RegPack(RF, InData%iJUT) + call RegPack(RF, InData%iJL) + call RegPackAlloc(RF, InData%iModInit) + call RegPackAlloc(RF, InData%iModTC) + call RegPackAlloc(RF, InData%iModOpt1) + call RegPackAlloc(RF, InData%iModOpt2) + call RegPackAlloc(RF, InData%iModPost) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackTCParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Glue_TCParam), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackTCParam' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%h); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ConvTol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumCrctn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MaxConvIter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NIter_UJac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NStep_UJac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Scale_UJac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RhoInf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AlphaM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AlphaF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Beta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gamma); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BetaPrime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GammaPrime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumJ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumQ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumUT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iX1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iX2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iUT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iU1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iUL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iyT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iy1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iJX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iJU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iJUT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iJL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iModInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iModTC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iModOpt1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iModOpt2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iModPost); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(Glue_ParameterType), intent(in) :: SrcParamData + type(Glue_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + call Glue_CopyLinParam(SrcParamData%Lin, DstParamData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Glue_CopyTCParam(SrcParamData%TC, DstParamData%TC, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine Glue_DestroyParam(ParamData, ErrStat, ErrMsg) + type(Glue_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + call Glue_DestroyLinParam(ParamData%Lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyTCParam(ParamData%TC, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Glue_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Glue_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackParam' + if (RF%ErrStat >= AbortErrLev) return + call Glue_PackLinParam(RF, InData%Lin) + call Glue_PackTCParam(RF, InData%TC) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Glue_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackParam' + if (RF%ErrStat /= ErrID_None) return + call Glue_UnpackLinParam(RF, OutData%Lin) ! Lin + call Glue_UnpackTCParam(RF, OutData%TC) ! TC +end subroutine + +subroutine Glue_CopyLinSave(SrcLinSaveData, DstLinSaveData, CtrlCode, ErrStat, ErrMsg) + type(Glue_LinSave), intent(in) :: SrcLinSaveData + type(Glue_LinSave), intent(inout) :: DstLinSaveData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Glue_CopyLinSave' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcLinSaveData%Times)) then + LB(1:1) = lbound(SrcLinSaveData%Times) + UB(1:1) = ubound(SrcLinSaveData%Times) + if (.not. allocated(DstLinSaveData%Times)) then + allocate(DstLinSaveData%Times(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinSaveData%Times.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinSaveData%Times = SrcLinSaveData%Times + end if + if (allocated(SrcLinSaveData%u)) then + LB(1:2) = lbound(SrcLinSaveData%u) + UB(1:2) = ubound(SrcLinSaveData%u) + if (.not. allocated(DstLinSaveData%u)) then + allocate(DstLinSaveData%u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinSaveData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinSaveData%u = SrcLinSaveData%u + end if + if (allocated(SrcLinSaveData%x)) then + LB(1:2) = lbound(SrcLinSaveData%x) + UB(1:2) = ubound(SrcLinSaveData%x) + if (.not. allocated(DstLinSaveData%x)) then + allocate(DstLinSaveData%x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinSaveData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinSaveData%x = SrcLinSaveData%x + end if + if (allocated(SrcLinSaveData%xd)) then + LB(1:2) = lbound(SrcLinSaveData%xd) + UB(1:2) = ubound(SrcLinSaveData%xd) + if (.not. allocated(DstLinSaveData%xd)) then + allocate(DstLinSaveData%xd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinSaveData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinSaveData%xd = SrcLinSaveData%xd + end if + if (allocated(SrcLinSaveData%z)) then + LB(1:2) = lbound(SrcLinSaveData%z) + UB(1:2) = ubound(SrcLinSaveData%z) + if (.not. allocated(DstLinSaveData%z)) then + allocate(DstLinSaveData%z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinSaveData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinSaveData%z = SrcLinSaveData%z + end if + if (allocated(SrcLinSaveData%OtherSt)) then + LB(1:2) = lbound(SrcLinSaveData%OtherSt) + UB(1:2) = ubound(SrcLinSaveData%OtherSt) + if (.not. allocated(DstLinSaveData%OtherSt)) then + allocate(DstLinSaveData%OtherSt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinSaveData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinSaveData%OtherSt = SrcLinSaveData%OtherSt + end if +end subroutine + +subroutine Glue_DestroyLinSave(LinSaveData, ErrStat, ErrMsg) + type(Glue_LinSave), intent(inout) :: LinSaveData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_DestroyLinSave' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(LinSaveData%Times)) then + deallocate(LinSaveData%Times) + end if + if (allocated(LinSaveData%u)) then + deallocate(LinSaveData%u) + end if + if (allocated(LinSaveData%x)) then + deallocate(LinSaveData%x) + end if + if (allocated(LinSaveData%xd)) then + deallocate(LinSaveData%xd) + end if + if (allocated(LinSaveData%z)) then + deallocate(LinSaveData%z) + end if + if (allocated(LinSaveData%OtherSt)) then + deallocate(LinSaveData%OtherSt) + end if +end subroutine + +subroutine Glue_PackLinSave(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Glue_LinSave), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackLinSave' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Times) + call RegPackAlloc(RF, InData%u) + call RegPackAlloc(RF, InData%x) + call RegPackAlloc(RF, InData%xd) + call RegPackAlloc(RF, InData%z) + call RegPackAlloc(RF, InData%OtherSt) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackLinSave(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Glue_LinSave), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackLinSave' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Times); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%xd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OtherSt); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, CtrlCode, ErrStat, ErrMsg) + type(Glue_OutputFileType), intent(in) :: SrcOutputFileTypeData + type(Glue_OutputFileType), intent(inout) :: DstOutputFileTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_CopyOutputFileType' + ErrStat = ErrID_None + ErrMsg = '' + call Glue_CopyLinSave(SrcOutputFileTypeData%Lin, DstOutputFileTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine Glue_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) + type(Glue_OutputFileType), intent(inout) :: OutputFileTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_DestroyOutputFileType' + ErrStat = ErrID_None + ErrMsg = '' + call Glue_DestroyLinSave(OutputFileTypeData%Lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Glue_PackOutputFileType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Glue_OutputFileType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackOutputFileType' + if (RF%ErrStat >= AbortErrLev) return + call Glue_PackLinSave(RF, InData%Lin) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackOutputFileType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Glue_OutputFileType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackOutputFileType' + if (RF%ErrStat /= ErrID_None) return + call Glue_UnpackLinSave(RF, OutData%Lin) ! Lin +end subroutine + +subroutine Glue_CopyCalcSteady(SrcCalcSteadyData, DstCalcSteadyData, CtrlCode, ErrStat, ErrMsg) + type(Glue_CalcSteady), intent(in) :: SrcCalcSteadyData + type(Glue_CalcSteady), intent(inout) :: DstCalcSteadyData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Glue_CopyCalcSteady' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcCalcSteadyData%AzimuthTarget)) then + LB(1:1) = lbound(SrcCalcSteadyData%AzimuthTarget) + UB(1:1) = ubound(SrcCalcSteadyData%AzimuthTarget) + if (.not. allocated(DstCalcSteadyData%AzimuthTarget)) then + allocate(DstCalcSteadyData%AzimuthTarget(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCalcSteadyData%AzimuthTarget.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCalcSteadyData%AzimuthTarget = SrcCalcSteadyData%AzimuthTarget + end if + DstCalcSteadyData%AzimuthDelta = SrcCalcSteadyData%AzimuthDelta + DstCalcSteadyData%IsConverged = SrcCalcSteadyData%IsConverged + DstCalcSteadyData%FoundSteady = SrcCalcSteadyData%FoundSteady + DstCalcSteadyData%ForceLin = SrcCalcSteadyData%ForceLin + DstCalcSteadyData%NumRotations = SrcCalcSteadyData%NumRotations + DstCalcSteadyData%NumOutputs = SrcCalcSteadyData%NumOutputs + if (allocated(SrcCalcSteadyData%psi_buffer)) then + LB(1:1) = lbound(SrcCalcSteadyData%psi_buffer) + UB(1:1) = ubound(SrcCalcSteadyData%psi_buffer) + if (.not. allocated(DstCalcSteadyData%psi_buffer)) then + allocate(DstCalcSteadyData%psi_buffer(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCalcSteadyData%psi_buffer.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCalcSteadyData%psi_buffer = SrcCalcSteadyData%psi_buffer + end if + if (allocated(SrcCalcSteadyData%y_buffer)) then + LB(1:2) = lbound(SrcCalcSteadyData%y_buffer) + UB(1:2) = ubound(SrcCalcSteadyData%y_buffer) + if (.not. allocated(DstCalcSteadyData%y_buffer)) then + allocate(DstCalcSteadyData%y_buffer(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCalcSteadyData%y_buffer.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCalcSteadyData%y_buffer = SrcCalcSteadyData%y_buffer + end if + if (allocated(SrcCalcSteadyData%y_azimuth)) then + LB(1:2) = lbound(SrcCalcSteadyData%y_azimuth) + UB(1:2) = ubound(SrcCalcSteadyData%y_azimuth) + if (.not. allocated(DstCalcSteadyData%y_azimuth)) then + allocate(DstCalcSteadyData%y_azimuth(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCalcSteadyData%y_azimuth.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCalcSteadyData%y_azimuth = SrcCalcSteadyData%y_azimuth + end if + if (allocated(SrcCalcSteadyData%y_interp)) then + LB(1:1) = lbound(SrcCalcSteadyData%y_interp) + UB(1:1) = ubound(SrcCalcSteadyData%y_interp) + if (.not. allocated(DstCalcSteadyData%y_interp)) then + allocate(DstCalcSteadyData%y_interp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCalcSteadyData%y_interp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCalcSteadyData%y_interp = SrcCalcSteadyData%y_interp + end if + if (allocated(SrcCalcSteadyData%y_diff)) then + LB(1:1) = lbound(SrcCalcSteadyData%y_diff) + UB(1:1) = ubound(SrcCalcSteadyData%y_diff) + if (.not. allocated(DstCalcSteadyData%y_diff)) then + allocate(DstCalcSteadyData%y_diff(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCalcSteadyData%y_diff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCalcSteadyData%y_diff = SrcCalcSteadyData%y_diff + end if + if (allocated(SrcCalcSteadyData%y_ref)) then + LB(1:1) = lbound(SrcCalcSteadyData%y_ref) + UB(1:1) = ubound(SrcCalcSteadyData%y_ref) + if (.not. allocated(DstCalcSteadyData%y_ref)) then + allocate(DstCalcSteadyData%y_ref(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCalcSteadyData%y_ref.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCalcSteadyData%y_ref = SrcCalcSteadyData%y_ref + end if +end subroutine + +subroutine Glue_DestroyCalcSteady(CalcSteadyData, ErrStat, ErrMsg) + type(Glue_CalcSteady), intent(inout) :: CalcSteadyData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_DestroyCalcSteady' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(CalcSteadyData%AzimuthTarget)) then + deallocate(CalcSteadyData%AzimuthTarget) + end if + if (allocated(CalcSteadyData%psi_buffer)) then + deallocate(CalcSteadyData%psi_buffer) + end if + if (allocated(CalcSteadyData%y_buffer)) then + deallocate(CalcSteadyData%y_buffer) + end if + if (allocated(CalcSteadyData%y_azimuth)) then + deallocate(CalcSteadyData%y_azimuth) + end if + if (allocated(CalcSteadyData%y_interp)) then + deallocate(CalcSteadyData%y_interp) + end if + if (allocated(CalcSteadyData%y_diff)) then + deallocate(CalcSteadyData%y_diff) + end if + if (allocated(CalcSteadyData%y_ref)) then + deallocate(CalcSteadyData%y_ref) + end if +end subroutine + +subroutine Glue_PackCalcSteady(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Glue_CalcSteady), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackCalcSteady' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%AzimuthTarget) + call RegPack(RF, InData%AzimuthDelta) + call RegPack(RF, InData%IsConverged) + call RegPack(RF, InData%FoundSteady) + call RegPack(RF, InData%ForceLin) + call RegPack(RF, InData%NumRotations) + call RegPack(RF, InData%NumOutputs) + call RegPackAlloc(RF, InData%psi_buffer) + call RegPackAlloc(RF, InData%y_buffer) + call RegPackAlloc(RF, InData%y_azimuth) + call RegPackAlloc(RF, InData%y_interp) + call RegPackAlloc(RF, InData%y_diff) + call RegPackAlloc(RF, InData%y_ref) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackCalcSteady(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Glue_CalcSteady), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackCalcSteady' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%AzimuthTarget); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AzimuthDelta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IsConverged); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FoundSteady); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ForceLin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumRotations); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOutputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%psi_buffer); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_buffer); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_azimuth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_interp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_diff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_ref); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_CopyAeroMapCase(SrcAeroMapCaseData, DstAeroMapCaseData, CtrlCode, ErrStat, ErrMsg) + type(AeroMapCase), intent(in) :: SrcAeroMapCaseData + type(AeroMapCase), intent(inout) :: DstAeroMapCaseData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_CopyAeroMapCase' + ErrStat = ErrID_None + ErrMsg = '' + DstAeroMapCaseData%RotSpeed = SrcAeroMapCaseData%RotSpeed + DstAeroMapCaseData%TSR = SrcAeroMapCaseData%TSR + DstAeroMapCaseData%WindSpeed = SrcAeroMapCaseData%WindSpeed + DstAeroMapCaseData%Pitch = SrcAeroMapCaseData%Pitch +end subroutine + +subroutine Glue_DestroyAeroMapCase(AeroMapCaseData, ErrStat, ErrMsg) + type(AeroMapCase), intent(inout) :: AeroMapCaseData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_DestroyAeroMapCase' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Glue_PackAeroMapCase(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AeroMapCase), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackAeroMapCase' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%TSR) + call RegPack(RF, InData%WindSpeed) + call RegPack(RF, InData%Pitch) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackAeroMapCase(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AeroMapCase), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackAeroMapCase' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TSR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Pitch); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_CopyAeroMap(SrcAeroMapData, DstAeroMapData, CtrlCode, ErrStat, ErrMsg) + type(Glue_AeroMap), intent(in) :: SrcAeroMapData + type(Glue_AeroMap), intent(inout) :: DstAeroMapData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_CopyAeroMap' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcAeroMapData%iModOrder)) then + LB(1:1) = lbound(SrcAeroMapData%iModOrder) + UB(1:1) = ubound(SrcAeroMapData%iModOrder) + if (.not. allocated(DstAeroMapData%iModOrder)) then + allocate(DstAeroMapData%iModOrder(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%iModOrder.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroMapData%iModOrder = SrcAeroMapData%iModOrder + end if + call Glue_CopyModGlueType(SrcAeroMapData%Mod, DstAeroMapData%Mod, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcAeroMapData%Jac11)) then + LB(1:2) = lbound(SrcAeroMapData%Jac11) + UB(1:2) = ubound(SrcAeroMapData%Jac11) + if (.not. allocated(DstAeroMapData%Jac11)) then + allocate(DstAeroMapData%Jac11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%Jac11.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroMapData%Jac11 = SrcAeroMapData%Jac11 + end if + if (allocated(SrcAeroMapData%Jac12)) then + LB(1:2) = lbound(SrcAeroMapData%Jac12) + UB(1:2) = ubound(SrcAeroMapData%Jac12) + if (.not. allocated(DstAeroMapData%Jac12)) then + allocate(DstAeroMapData%Jac12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%Jac12.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroMapData%Jac12 = SrcAeroMapData%Jac12 + end if + if (allocated(SrcAeroMapData%Jac21)) then + LB(1:2) = lbound(SrcAeroMapData%Jac21) + UB(1:2) = ubound(SrcAeroMapData%Jac21) + if (.not. allocated(DstAeroMapData%Jac21)) then + allocate(DstAeroMapData%Jac21(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%Jac21.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroMapData%Jac21 = SrcAeroMapData%Jac21 + end if + if (allocated(SrcAeroMapData%Jac22)) then + LB(1:2) = lbound(SrcAeroMapData%Jac22) + UB(1:2) = ubound(SrcAeroMapData%Jac22) + if (.not. allocated(DstAeroMapData%Jac22)) then + allocate(DstAeroMapData%Jac22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%Jac22.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroMapData%Jac22 = SrcAeroMapData%Jac22 + end if + if (allocated(SrcAeroMapData%JacPivot)) then + LB(1:1) = lbound(SrcAeroMapData%JacPivot) + UB(1:1) = ubound(SrcAeroMapData%JacPivot) + if (.not. allocated(DstAeroMapData%JacPivot)) then + allocate(DstAeroMapData%JacPivot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%JacPivot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroMapData%JacPivot = SrcAeroMapData%JacPivot + end if + DstAeroMapData%JacScale = SrcAeroMapData%JacScale + DstAeroMapData%SolveTolerance = SrcAeroMapData%SolveTolerance + if (allocated(SrcAeroMapData%HubOrientation)) then + LB(1:3) = lbound(SrcAeroMapData%HubOrientation) + UB(1:3) = ubound(SrcAeroMapData%HubOrientation) + if (.not. allocated(DstAeroMapData%HubOrientation)) then + allocate(DstAeroMapData%HubOrientation(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%HubOrientation.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroMapData%HubOrientation = SrcAeroMapData%HubOrientation + end if + if (allocated(SrcAeroMapData%u1)) then + LB(1:1) = lbound(SrcAeroMapData%u1) + UB(1:1) = ubound(SrcAeroMapData%u1) + if (.not. allocated(DstAeroMapData%u1)) then + allocate(DstAeroMapData%u1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%u1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroMapData%u1 = SrcAeroMapData%u1 + end if + if (allocated(SrcAeroMapData%u2)) then + LB(1:1) = lbound(SrcAeroMapData%u2) + UB(1:1) = ubound(SrcAeroMapData%u2) + if (.not. allocated(DstAeroMapData%u2)) then + allocate(DstAeroMapData%u2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%u2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroMapData%u2 = SrcAeroMapData%u2 + end if + if (allocated(SrcAeroMapData%Residual)) then + LB(1:1) = lbound(SrcAeroMapData%Residual) + UB(1:1) = ubound(SrcAeroMapData%Residual) + if (.not. allocated(DstAeroMapData%Residual)) then + allocate(DstAeroMapData%Residual(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%Residual.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroMapData%Residual = SrcAeroMapData%Residual + end if + if (allocated(SrcAeroMapData%SolveDelta)) then + LB(1:1) = lbound(SrcAeroMapData%SolveDelta) + UB(1:1) = ubound(SrcAeroMapData%SolveDelta) + if (.not. allocated(DstAeroMapData%SolveDelta)) then + allocate(DstAeroMapData%SolveDelta(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%SolveDelta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroMapData%SolveDelta = SrcAeroMapData%SolveDelta + end if + if (allocated(SrcAeroMapData%Cases)) then + LB(1:1) = lbound(SrcAeroMapData%Cases) + UB(1:1) = ubound(SrcAeroMapData%Cases) + if (.not. allocated(DstAeroMapData%Cases)) then + allocate(DstAeroMapData%Cases(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroMapData%Cases.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Glue_CopyAeroMapCase(SrcAeroMapData%Cases(i1), DstAeroMapData%Cases(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstAeroMapData%LinFileNum = SrcAeroMapData%LinFileNum +end subroutine + +subroutine Glue_DestroyAeroMap(AeroMapData, ErrStat, ErrMsg) + type(Glue_AeroMap), intent(inout) :: AeroMapData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_DestroyAeroMap' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(AeroMapData%iModOrder)) then + deallocate(AeroMapData%iModOrder) + end if + call Glue_DestroyModGlueType(AeroMapData%Mod, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(AeroMapData%Jac11)) then + deallocate(AeroMapData%Jac11) + end if + if (allocated(AeroMapData%Jac12)) then + deallocate(AeroMapData%Jac12) + end if + if (allocated(AeroMapData%Jac21)) then + deallocate(AeroMapData%Jac21) + end if + if (allocated(AeroMapData%Jac22)) then + deallocate(AeroMapData%Jac22) + end if + if (allocated(AeroMapData%JacPivot)) then + deallocate(AeroMapData%JacPivot) + end if + if (allocated(AeroMapData%HubOrientation)) then + deallocate(AeroMapData%HubOrientation) + end if + if (allocated(AeroMapData%u1)) then + deallocate(AeroMapData%u1) + end if + if (allocated(AeroMapData%u2)) then + deallocate(AeroMapData%u2) + end if + if (allocated(AeroMapData%Residual)) then + deallocate(AeroMapData%Residual) + end if + if (allocated(AeroMapData%SolveDelta)) then + deallocate(AeroMapData%SolveDelta) + end if + if (allocated(AeroMapData%Cases)) then + LB(1:1) = lbound(AeroMapData%Cases) + UB(1:1) = ubound(AeroMapData%Cases) + do i1 = LB(1), UB(1) + call Glue_DestroyAeroMapCase(AeroMapData%Cases(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroMapData%Cases) + end if +end subroutine + +subroutine Glue_PackAeroMap(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Glue_AeroMap), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackAeroMap' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%iModOrder) + call Glue_PackModGlueType(RF, InData%Mod) + call RegPackAlloc(RF, InData%Jac11) + call RegPackAlloc(RF, InData%Jac12) + call RegPackAlloc(RF, InData%Jac21) + call RegPackAlloc(RF, InData%Jac22) + call RegPackAlloc(RF, InData%JacPivot) + call RegPack(RF, InData%JacScale) + call RegPack(RF, InData%SolveTolerance) + call RegPackAlloc(RF, InData%HubOrientation) + call RegPackAlloc(RF, InData%u1) + call RegPackAlloc(RF, InData%u2) + call RegPackAlloc(RF, InData%Residual) + call RegPackAlloc(RF, InData%SolveDelta) + call RegPack(RF, allocated(InData%Cases)) + if (allocated(InData%Cases)) then + call RegPackBounds(RF, 1, lbound(InData%Cases), ubound(InData%Cases)) + LB(1:1) = lbound(InData%Cases) + UB(1:1) = ubound(InData%Cases) + do i1 = LB(1), UB(1) + call Glue_PackAeroMapCase(RF, InData%Cases(i1)) + end do + end if + call RegPack(RF, InData%LinFileNum) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackAeroMap(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Glue_AeroMap), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackAeroMap' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%iModOrder); if (RegCheckErr(RF, RoutineName)) return + call Glue_UnpackModGlueType(RF, OutData%Mod) ! Mod + call RegUnpackAlloc(RF, OutData%Jac11); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac12); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac21); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac22); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%JacPivot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JacScale); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SolveTolerance); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HubOrientation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Residual); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SolveDelta); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%Cases)) deallocate(OutData%Cases) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Cases(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cases.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Glue_UnpackAeroMapCase(RF, OutData%Cases(i1)) ! Cases + end do + end if + call RegUnpack(RF, OutData%LinFileNum); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_CopyTC_State(SrcTC_StateData, DstTC_StateData, CtrlCode, ErrStat, ErrMsg) + type(TC_State), intent(in) :: SrcTC_StateData + type(TC_State), intent(inout) :: DstTC_StateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Glue_CopyTC_State' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcTC_StateData%q_prev)) then + LB(1:1) = lbound(SrcTC_StateData%q_prev) + UB(1:1) = ubound(SrcTC_StateData%q_prev) + if (.not. allocated(DstTC_StateData%q_prev)) then + allocate(DstTC_StateData%q_prev(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_StateData%q_prev.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_StateData%q_prev = SrcTC_StateData%q_prev + end if + if (allocated(SrcTC_StateData%x)) then + LB(1:1) = lbound(SrcTC_StateData%x) + UB(1:1) = ubound(SrcTC_StateData%x) + if (.not. allocated(DstTC_StateData%x)) then + allocate(DstTC_StateData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_StateData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_StateData%x = SrcTC_StateData%x + end if + if (allocated(SrcTC_StateData%q)) then + LB(1:1) = lbound(SrcTC_StateData%q) + UB(1:1) = ubound(SrcTC_StateData%q) + if (.not. allocated(DstTC_StateData%q)) then + allocate(DstTC_StateData%q(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_StateData%q.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_StateData%q = SrcTC_StateData%q + end if + if (allocated(SrcTC_StateData%v)) then + LB(1:1) = lbound(SrcTC_StateData%v) + UB(1:1) = ubound(SrcTC_StateData%v) + if (.not. allocated(DstTC_StateData%v)) then + allocate(DstTC_StateData%v(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_StateData%v.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_StateData%v = SrcTC_StateData%v + end if + if (allocated(SrcTC_StateData%vd)) then + LB(1:1) = lbound(SrcTC_StateData%vd) + UB(1:1) = ubound(SrcTC_StateData%vd) + if (.not. allocated(DstTC_StateData%vd)) then + allocate(DstTC_StateData%vd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_StateData%vd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_StateData%vd = SrcTC_StateData%vd + end if + if (allocated(SrcTC_StateData%a)) then + LB(1:1) = lbound(SrcTC_StateData%a) + UB(1:1) = ubound(SrcTC_StateData%a) + if (.not. allocated(DstTC_StateData%a)) then + allocate(DstTC_StateData%a(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_StateData%a.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_StateData%a = SrcTC_StateData%a + end if +end subroutine + +subroutine Glue_DestroyTC_State(TC_StateData, ErrStat, ErrMsg) + type(TC_State), intent(inout) :: TC_StateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_DestroyTC_State' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(TC_StateData%q_prev)) then + deallocate(TC_StateData%q_prev) + end if + if (allocated(TC_StateData%x)) then + deallocate(TC_StateData%x) + end if + if (allocated(TC_StateData%q)) then + deallocate(TC_StateData%q) + end if + if (allocated(TC_StateData%v)) then + deallocate(TC_StateData%v) + end if + if (allocated(TC_StateData%vd)) then + deallocate(TC_StateData%vd) + end if + if (allocated(TC_StateData%a)) then + deallocate(TC_StateData%a) + end if +end subroutine + +subroutine Glue_PackTC_State(RF, Indata) + type(RegFile), intent(inout) :: RF + type(TC_State), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackTC_State' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%q_prev) + call RegPackAlloc(RF, InData%x) + call RegPackAlloc(RF, InData%q) + call RegPackAlloc(RF, InData%v) + call RegPackAlloc(RF, InData%vd) + call RegPackAlloc(RF, InData%a) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackTC_State(RF, OutData) + type(RegFile), intent(inout) :: RF + type(TC_State), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackTC_State' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%q_prev); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%q); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%v); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%vd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%a); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_CopyTCMisc(SrcTCMiscData, DstTCMiscData, CtrlCode, ErrStat, ErrMsg) + type(Glue_TCMisc), intent(in) :: SrcTCMiscData + type(Glue_TCMisc), intent(inout) :: DstTCMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_CopyTCMisc' + ErrStat = ErrID_None + ErrMsg = '' + call Glue_CopyModGlueType(SrcTCMiscData%Mod, DstTCMiscData%Mod, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Glue_CopyTC_State(SrcTCMiscData%StateCurr, DstTCMiscData%StateCurr, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Glue_CopyTC_State(SrcTCMiscData%StatePred, DstTCMiscData%StatePred, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcTCMiscData%UCalc)) then + LB(1:1) = lbound(SrcTCMiscData%UCalc) + UB(1:1) = ubound(SrcTCMiscData%UCalc) + if (.not. allocated(DstTCMiscData%UCalc)) then + allocate(DstTCMiscData%UCalc(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCMiscData%UCalc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCMiscData%UCalc = SrcTCMiscData%UCalc + end if + if (allocated(SrcTCMiscData%XB)) then + LB(1:2) = lbound(SrcTCMiscData%XB) + UB(1:2) = ubound(SrcTCMiscData%XB) + if (.not. allocated(DstTCMiscData%XB)) then + allocate(DstTCMiscData%XB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCMiscData%XB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCMiscData%XB = SrcTCMiscData%XB + end if + if (allocated(SrcTCMiscData%IPIV)) then + LB(1:1) = lbound(SrcTCMiscData%IPIV) + UB(1:1) = ubound(SrcTCMiscData%IPIV) + if (.not. allocated(DstTCMiscData%IPIV)) then + allocate(DstTCMiscData%IPIV(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCMiscData%IPIV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCMiscData%IPIV = SrcTCMiscData%IPIV + end if + DstTCMiscData%IterTotal = SrcTCMiscData%IterTotal + DstTCMiscData%UJacIterRemain = SrcTCMiscData%UJacIterRemain + DstTCMiscData%UJacStepsRemain = SrcTCMiscData%UJacStepsRemain + DstTCMiscData%ConvWarn = SrcTCMiscData%ConvWarn + if (allocated(SrcTCMiscData%XB_IO)) then + LB(1:2) = lbound(SrcTCMiscData%XB_IO) + UB(1:2) = ubound(SrcTCMiscData%XB_IO) + if (.not. allocated(DstTCMiscData%XB_IO)) then + allocate(DstTCMiscData%XB_IO(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCMiscData%XB_IO.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCMiscData%XB_IO = SrcTCMiscData%XB_IO + end if + if (allocated(SrcTCMiscData%Jac_IO)) then + LB(1:2) = lbound(SrcTCMiscData%Jac_IO) + UB(1:2) = ubound(SrcTCMiscData%Jac_IO) + if (.not. allocated(DstTCMiscData%Jac_IO)) then + allocate(DstTCMiscData%Jac_IO(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCMiscData%Jac_IO.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCMiscData%Jac_IO = SrcTCMiscData%Jac_IO + end if + if (allocated(SrcTCMiscData%J11)) then + LB(1:2) = lbound(SrcTCMiscData%J11) + UB(1:2) = ubound(SrcTCMiscData%J11) + if (.not. allocated(DstTCMiscData%J11)) then + allocate(DstTCMiscData%J11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCMiscData%J11.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCMiscData%J11 = SrcTCMiscData%J11 + end if + if (allocated(SrcTCMiscData%J12)) then + LB(1:2) = lbound(SrcTCMiscData%J12) + UB(1:2) = ubound(SrcTCMiscData%J12) + if (.not. allocated(DstTCMiscData%J12)) then + allocate(DstTCMiscData%J12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCMiscData%J12.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCMiscData%J12 = SrcTCMiscData%J12 + end if + if (allocated(SrcTCMiscData%J21)) then + LB(1:2) = lbound(SrcTCMiscData%J21) + UB(1:2) = ubound(SrcTCMiscData%J21) + if (.not. allocated(DstTCMiscData%J21)) then + allocate(DstTCMiscData%J21(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCMiscData%J21.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCMiscData%J21 = SrcTCMiscData%J21 + end if + if (allocated(SrcTCMiscData%J22)) then + LB(1:2) = lbound(SrcTCMiscData%J22) + UB(1:2) = ubound(SrcTCMiscData%J22) + if (.not. allocated(DstTCMiscData%J22)) then + allocate(DstTCMiscData%J22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTCMiscData%J22.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTCMiscData%J22 = SrcTCMiscData%J22 + end if +end subroutine + +subroutine Glue_DestroyTCMisc(TCMiscData, ErrStat, ErrMsg) + type(Glue_TCMisc), intent(inout) :: TCMiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_DestroyTCMisc' + ErrStat = ErrID_None + ErrMsg = '' + call Glue_DestroyModGlueType(TCMiscData%Mod, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyTC_State(TCMiscData%StateCurr, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyTC_State(TCMiscData%StatePred, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(TCMiscData%UCalc)) then + deallocate(TCMiscData%UCalc) + end if + if (allocated(TCMiscData%XB)) then + deallocate(TCMiscData%XB) + end if + if (allocated(TCMiscData%IPIV)) then + deallocate(TCMiscData%IPIV) + end if + if (allocated(TCMiscData%XB_IO)) then + deallocate(TCMiscData%XB_IO) + end if + if (allocated(TCMiscData%Jac_IO)) then + deallocate(TCMiscData%Jac_IO) + end if + if (allocated(TCMiscData%J11)) then + deallocate(TCMiscData%J11) + end if + if (allocated(TCMiscData%J12)) then + deallocate(TCMiscData%J12) + end if + if (allocated(TCMiscData%J21)) then + deallocate(TCMiscData%J21) + end if + if (allocated(TCMiscData%J22)) then + deallocate(TCMiscData%J22) + end if +end subroutine + +subroutine Glue_PackTCMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Glue_TCMisc), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackTCMisc' + if (RF%ErrStat >= AbortErrLev) return + call Glue_PackModGlueType(RF, InData%Mod) + call Glue_PackTC_State(RF, InData%StateCurr) + call Glue_PackTC_State(RF, InData%StatePred) + call RegPackAlloc(RF, InData%UCalc) + call RegPackAlloc(RF, InData%XB) + call RegPackAlloc(RF, InData%IPIV) + call RegPack(RF, InData%IterTotal) + call RegPack(RF, InData%UJacIterRemain) + call RegPack(RF, InData%UJacStepsRemain) + call RegPack(RF, InData%ConvWarn) + call RegPackAlloc(RF, InData%XB_IO) + call RegPackAlloc(RF, InData%Jac_IO) + call RegPackAlloc(RF, InData%J11) + call RegPackAlloc(RF, InData%J12) + call RegPackAlloc(RF, InData%J21) + call RegPackAlloc(RF, InData%J22) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackTCMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Glue_TCMisc), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackTCMisc' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call Glue_UnpackModGlueType(RF, OutData%Mod) ! Mod + call Glue_UnpackTC_State(RF, OutData%StateCurr) ! StateCurr + call Glue_UnpackTC_State(RF, OutData%StatePred) ! StatePred + call RegUnpackAlloc(RF, OutData%UCalc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%XB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IPIV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IterTotal); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UJacIterRemain); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UJacStepsRemain); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ConvWarn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%XB_IO); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_IO); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%J11); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%J12); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%J21); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%J22); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_CopyLinMisc(SrcLinMiscData, DstLinMiscData, CtrlCode, ErrStat, ErrMsg) + type(Glue_LinMisc), intent(in) :: SrcLinMiscData + type(Glue_LinMisc), intent(inout) :: DstLinMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_CopyLinMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstLinMiscData%TimeIndex = SrcLinMiscData%TimeIndex + DstLinMiscData%AzimuthIndex = SrcLinMiscData%AzimuthIndex + DstLinMiscData%IsConverged = SrcLinMiscData%IsConverged +end subroutine + +subroutine Glue_DestroyLinMisc(LinMiscData, ErrStat, ErrMsg) + type(Glue_LinMisc), intent(inout) :: LinMiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Glue_DestroyLinMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Glue_PackLinMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Glue_LinMisc), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackLinMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%TimeIndex) + call RegPack(RF, InData%AzimuthIndex) + call RegPack(RF, InData%IsConverged) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackLinMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Glue_LinMisc), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackLinMisc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%TimeIndex); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AzimuthIndex); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IsConverged); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(Glue_MiscVarType), intent(inout) :: SrcMiscData + type(Glue_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%ModData)) then + LB(1:1) = lbound(SrcMiscData%ModData) + UB(1:1) = ubound(SrcMiscData%ModData) + if (.not. allocated(DstMiscData%ModData)) then + allocate(DstMiscData%ModData(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ModData.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyModDataType(SrcMiscData%ModData(i1), DstMiscData%ModData(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%Mappings)) then + LB(1:1) = lbound(SrcMiscData%Mappings) + UB(1:1) = ubound(SrcMiscData%Mappings) + if (.not. allocated(DstMiscData%Mappings)) then + allocate(DstMiscData%Mappings(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Mappings.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Glue_CopyMappingType(SrcMiscData%Mappings(i1), DstMiscData%Mappings(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call Glue_CopyModGlueType(SrcMiscData%ModGlue, DstMiscData%ModGlue, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Glue_CopyLinMisc(SrcMiscData%Lin, DstMiscData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Glue_CopyCalcSteady(SrcMiscData%CS, DstMiscData%CS, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Glue_CopyAeroMap(SrcMiscData%AM, DstMiscData%AM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Glue_CopyTCMisc(SrcMiscData%TC, DstMiscData%TC, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine Glue_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(Glue_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Glue_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%ModData)) then + LB(1:1) = lbound(MiscData%ModData) + UB(1:1) = ubound(MiscData%ModData) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyModDataType(MiscData%ModData(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%ModData) + end if + if (allocated(MiscData%Mappings)) then + LB(1:1) = lbound(MiscData%Mappings) + UB(1:1) = ubound(MiscData%Mappings) + do i1 = LB(1), UB(1) + call Glue_DestroyMappingType(MiscData%Mappings(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%Mappings) + end if + call Glue_DestroyModGlueType(MiscData%ModGlue, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyLinMisc(MiscData%Lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyCalcSteady(MiscData%CS, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyAeroMap(MiscData%AM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Glue_DestroyTCMisc(MiscData%TC, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Glue_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Glue_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Glue_PackMisc' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%ModData)) + if (allocated(InData%ModData)) then + call RegPackBounds(RF, 1, lbound(InData%ModData), ubound(InData%ModData)) + LB(1:1) = lbound(InData%ModData) + UB(1:1) = ubound(InData%ModData) + do i1 = LB(1), UB(1) + call NWTC_Library_PackModDataType(RF, InData%ModData(i1)) + end do + end if + call RegPack(RF, allocated(InData%Mappings)) + if (allocated(InData%Mappings)) then + call RegPackBounds(RF, 1, lbound(InData%Mappings), ubound(InData%Mappings)) + LB(1:1) = lbound(InData%Mappings) + UB(1:1) = ubound(InData%Mappings) + do i1 = LB(1), UB(1) + call Glue_PackMappingType(RF, InData%Mappings(i1)) + end do + end if + call Glue_PackModGlueType(RF, InData%ModGlue) + call Glue_PackLinMisc(RF, InData%Lin) + call Glue_PackCalcSteady(RF, InData%CS) + call Glue_PackAeroMap(RF, InData%AM) + call Glue_PackTCMisc(RF, InData%TC) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Glue_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Glue_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Glue_UnPackMisc' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%ModData)) deallocate(OutData%ModData) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%ModData(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ModData.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackModDataType(RF, OutData%ModData(i1)) ! ModData + end do + end if + if (allocated(OutData%Mappings)) deallocate(OutData%Mappings) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Mappings(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mappings.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Glue_UnpackMappingType(RF, OutData%Mappings(i1)) ! Mappings + end do + end if + call Glue_UnpackModGlueType(RF, OutData%ModGlue) ! ModGlue + call Glue_UnpackLinMisc(RF, OutData%Lin) ! Lin + call Glue_UnpackCalcSteady(RF, OutData%CS) ! CS + call Glue_UnpackAeroMap(RF, OutData%AM) ! AM + call Glue_UnpackTCMisc(RF, OutData%TC) ! TC +end subroutine + +END MODULE Glue_Types + +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/openfast-registry/src/registry.hpp b/modules/openfast-registry/src/registry.hpp index f615fb7a15..eb7112f029 100644 --- a/modules/openfast-registry/src/registry.hpp +++ b/modules/openfast-registry/src/registry.hpp @@ -9,6 +9,7 @@ #include #include #include +#include std::string tolower(std::string s); @@ -307,6 +308,94 @@ struct DataType // Derived data type and all of its fields only contain reals return true; } + + void get_field_names_paths(const std::string &name_prefix, const std::string &path_prefix, int index_num, std::vector &fields) + { + // Loop through fields + for (const auto &field : this->fields) + { + std::string array_index; + switch (field.rank) + { + case 5: + array_index = ", DL%i" + std::to_string(index_num + 5) + array_index; + case 4: + array_index = ", DL%i" + std::to_string(index_num + 4) + array_index; + case 3: + array_index = ", DL%i" + std::to_string(index_num + 3) + array_index; + case 2: + array_index = ", DL%i" + std::to_string(index_num + 2) + array_index; + case 1: + array_index = "(DL%i" + std::to_string(index_num + 1) + array_index + ")"; + } + + // If field is not derived or it is a mesh + if (field.data_type->tag != Tag::Derived) + { + auto new_field = field; + new_field.name = name_prefix + "_" + field.name; + new_field.desc = path_prefix + "%" + field.name; + fields.push_back(new_field); + } + else if ((tolower(field.data_type->derived.name).compare("meshtype") == 0)) + { + auto new_field = field; + new_field.name = name_prefix + "_" + field.name; + new_field.desc = path_prefix + "%" + field.name + array_index; + fields.push_back(new_field); + } + else + { + field.data_type->derived.get_field_names_paths(name_prefix + "_" + field.name, + path_prefix + "%" + field.name + array_index, + index_num + field.rank, fields); + } + } + } + + void get_mesh_names_paths(const std::string &name_prefix, const std::string &path_prefix, int index_num, std::vector &names, std::vector &paths) + { + // Loop through fields + for (const auto &field : this->fields) + { + // Skip fields that aren't derived types or don't contain meshes + if ((field.data_type->tag != Tag::Derived) || !field.data_type->derived.contains_mesh) + { + continue; + } + + auto &ddt = field.data_type->derived; + + std::string array_index; + switch (field.rank) + { + case 5: + array_index = ", DL%i" + std::to_string(index_num + 5) + array_index; + case 4: + array_index = ", DL%i" + std::to_string(index_num + 4) + array_index; + case 3: + array_index = ", DL%i" + std::to_string(index_num + 3) + array_index; + case 2: + array_index = ", DL%i" + std::to_string(index_num + 2) + array_index; + case 1: + array_index = "(DL%i" + std::to_string(index_num + 1) + array_index + ")"; + } + + // If this field is a mesh, add field name to vector + // otherwise get mesh names within derived type + if (tolower(ddt.name).compare("meshtype") == 0) + { + names.push_back(name_prefix + "_" + field.name); + paths.push_back(path_prefix + "%" + field.name + array_index); + } + else + { + field.data_type->derived.get_mesh_names_paths(name_prefix + "_" + field.name, + path_prefix + "%" + field.name + array_index, + index_num + field.rank, names, paths); + } + } + } }; Derived derived; diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index 2ecc53b1f6..105622ef22 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -1,5 +1,6 @@ #include #include +#include #include "registry.hpp" #include "templates.hpp" @@ -10,12 +11,13 @@ void gen_ExtrapInterp(std::ostream &w, const Module &mod, std::string type_name_ std::string type_kind, const bool useModPrefix); void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, const bool gen_c_code); -void gen_destroy(std::ostream &out, const Module &mod, const DataType::Derived &ddt, +void gen_destroy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, const bool gen_c_code); -void gen_pack(std::ostream &out, const Module &mod, const DataType::Derived &ddt, +void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, const bool gen_c_code); -void gen_unpack(std::ostream &out, const Module &mod, const DataType::Derived &ddt, +void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, bool gen_c_code); +void gen_var_routines(std::ostream &w, const Module &mod); void gen_copy_c2f(std::ostream &w, const Module &mod, const DataType::Derived &ddt); void gen_copy_f2c(std::ostream &w, const Module &mod, const DataType::Derived &ddt); @@ -90,6 +92,7 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) this->gen_fortran_subs(w, mod); + w << "\n"; w << "!ENDOFREGISTRYGENERATEDFILE\n"; return; } @@ -104,7 +107,8 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) // If this is the NWTC Library, we're not going to print "USE NWTC_Library" if (tolower(mod.name).compare("nwtc_library") == 0) - w << "USE SysSubs\n" + w << "USE Precision\n" + << "USE SysSubs\n" << "USE ModReg\n"; else w << "USE NWTC_Library\n"; @@ -114,7 +118,7 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) // Write parameters to file for (const auto ¶m : mod.params) { - w << " " << param.type->basic.type_fortran << ", PUBLIC, PARAMETER :: " << param.name; + w << " " << param.type->basic.type_fortran << ", PUBLIC, PARAMETER :: " << std::setw(32) << std::left << param.name; if (!param.value.empty()) w << " = " << param.value; @@ -291,13 +295,47 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) w << "! =======================\n"; } - w << "CONTAINS\n"; + int field_num = 0; + std::vector> field_params({ + {"ContinuousState", "x"}, + {"ConstraintState", "z"}, + {"Input", "u"}, + {"Output", "y"}, + }); + + for (const auto &tmp : field_params) + { + auto type_name = mod.nickname + "_" + tmp[0] + "Type"; + if (tolower(mod.name).compare("aerodyn") == 0) + { + type_name = std::string("Rot") + tmp[0] + "Type"; + } + auto it = mod.data_types.find(type_name); + if (it == mod.data_types.end()) + continue; + + // Get mesh names in derived type or subtypes and add parameters for identifying the mesh + std::string prefix = mod.nickname + "_" + tmp[1]; + auto &ddt = it->second->derived; + std::vector fields; + ddt.get_field_names_paths(prefix, mod.nickname, 0, fields); + auto param_type = this->find_data_type("integer"); + for (const auto &field : fields) + { + ++field_num; + // w << " type(DatDesc), public, parameter :: " << std::setw(32) << std::left << field.name << " = DatDesc(" << field_num << ", " << field.rank << ", \"" << field.desc << "\")\n"; + w << " integer(IntKi), public, parameter :: " << std::setw(32) << std::left << field.name << " = " << std::setw(3) << std::right << field_num << " ! " << field.desc << "\n" + << std::left; + } + } + + w << "\ncontains\n"; // Generate subroutines for this module this->gen_fortran_subs(w, mod); // Write module footer - w << "END MODULE " << mod.name << "_Types\n"; + w << "\nEND MODULE " << mod.name << "_Types\n\n"; w << "!ENDOFREGISTRYGENERATEDFILE\n"; } @@ -344,6 +382,8 @@ void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) if (tolower(mod.name).compare("aerodyn") == 0) gen_ExtrapInterp(w, mod, "InflowType", "DbKi", 1); } + + gen_var_routines(w, mod); } void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, @@ -1641,3 +1681,303 @@ void gen_copy_f2c(std::ostream &w, const Module &mod, const DataType::Derived &d w << indent << "END SUBROUTINE"; w << indent; } + +void gen_var_routines(std::ostream &w, const Module &mod) +{ + //-------------------------------------------------------------------------- + // Subroutines to get mesh pointer functions + //-------------------------------------------------------------------------- + + for (const auto &tmp : std::vector>{ + {"Input", "u"}, + {"Output", "y"}, + }) + { + auto type_name = mod.nickname + "_" + tmp[0] + "Type"; + if (tolower(mod.name).compare("aerodyn") == 0) + { + type_name = std::string("Rot") + tmp[0] + "Type"; + } + auto it = mod.data_types.find(type_name); + if (it == mod.data_types.end()) + { + continue; + } + auto &ddt = it->second->derived; + + // Get mesh names in derived type or subtypes and add parameters for identifying the mesh + std::vector mesh_names, mesh_paths; + ddt.get_mesh_names_paths(mod.nickname + "_" + tmp[1], tmp[1], 0, mesh_names, mesh_paths); + std::string routine_name = mod.nickname + "_" + tmp[0] + "MeshPointer"; + std::string indent("\n"); + + // Mesh pointer routine + w << indent << "function " << routine_name << "(" << tmp[1] << ", DL) result(Mesh)"; + indent += " "; + w << indent << std::setw(40) << "type(" + ddt.type_fortran + "), target, intent(in) " << ":: " << tmp[1]; + w << indent << "type(DatLoc), intent(in) :: DL"; + w << indent << "type(MeshType), pointer :: Mesh"; + w << indent << "nullify(Mesh)"; + w << indent << "select case (DL%Num)"; + for (int i = 0; i < mesh_paths.size(); ++i) + { + w << indent << "case (" << mesh_names[i] << ")"; + w << indent << " Mesh => " << mesh_paths[i]; + } + w << indent << "end select"; + indent.erase(indent.size() - 3); + w << indent << "end function"; + w << indent; + } + + //-------------------------------------------------------------------------- + // Subroutines to pack and unpack arrays based on variables + //-------------------------------------------------------------------------- + + for (const auto &tmp : std::vector>{ + {"ContinuousState", "x", "ContState"}, + {"ContinuousState", "x", "ContStateDeriv"}, + {"ConstraintState", "z", "ConstrState"}, + {"Input", "u", "Input"}, + {"Output", "y", "Output"}, + }) + { + auto base_type = tmp[0]; + auto &abbr = tmp[1]; + auto short_type = tmp[2]; + auto type_name = mod.nickname + "_" + base_type + "Type"; + if (tolower(mod.name).compare("aerodyn") == 0) + { + type_name = std::string("Rot") + base_type + "Type"; + } + auto it = mod.data_types.find(type_name); + if (it == mod.data_types.end()) + continue; + auto &ddt = it->second->derived; + + // Get mesh names in derived type or subtypes and add parameters for identifying the mesh + std::vector fields; + ddt.get_field_names_paths(mod.nickname + "_" + abbr, abbr, 0, fields); + + //-------------------------------- + // Vars packing routine + //-------------------------------- + + std::string routine_name = mod.nickname + "_VarsPack" + short_type; + std::string indent("\n"); + w << indent << "subroutine " << routine_name << "(Vars, " << abbr << ", ValAry)"; + indent += " "; + w << indent << std::setw(40) << "type(" + ddt.type_fortran + "), intent(in) " << ":: " << abbr; + w << indent << "type(ModVarsType), intent(in) :: Vars"; + w << indent << "real(R8Ki), intent(inout) :: ValAry(:)"; + w << indent << "integer(IntKi) :: i"; + w << indent << "do i = 1, size(Vars%" << abbr << ")"; + w << indent << " call " << mod.nickname + "_VarPack" + short_type + "(Vars%" << abbr << "(i), " << abbr << ", ValAry)"; + w << indent << "end do"; + indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; + + //-------------------------------- + // Var packing routine + //-------------------------------- + + w << indent << "subroutine " << mod.nickname + "_VarPack" + short_type + "(V, " << abbr << ", ValAry)"; + indent += " "; + w << indent << "type(ModVarType), intent(in) :: V"; + w << indent << std::setw(40) << "type(" + ddt.type_fortran + "), intent(in) " << ":: " << abbr; + w << indent << "real(R8Ki), intent(inout) :: ValAry(:)"; + w << indent << "associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2)))"; + indent += " "; + w << indent << "select case (DL%Num)"; + for (const auto &field : fields) + { + w << indent << "case (" << field.name << ")"; + std::string comment = "Scalar"; + auto field_path = field.desc; + if (field.data_type->tag == DataType::Tag::Derived) + { + comment = "Mesh"; + } + else if (field.rank > 0) + { + comment = std::string("Rank ") + std::to_string(field.rank) + " Array"; + } + + if ((field.name.compare("BD_x_q") == 0) && (short_type.compare("ContState") == 0)) + { + // This is a hack to convert BeamDyn's WM orientations to quaternions + w << indent << " if (V%Field == FieldOrientation) then"; + w << indent << " VarVals = wm_to_quat(wm_inv(x%q(4:6, V%j))) ! Convert WM parameters to quaternions"; + w << indent << " else"; + w << indent << std::setw(71) << " VarVals = " + field_path + "(V%iLB:V%iUB,V%j)" << "! " + comment; + w << indent << " end if"; + } + else if (field.data_type->tag == DataType::Tag::Derived) + { + w << indent << std::setw(71) <<" call MV_PackMesh(V, " + field_path + ", ValAry)" << " ! Mesh"; + } + else + { + std::string tmp; + switch (field.rank) + { + case 0: + tmp = "VarVals(1) = " + field_path; + break; + case 1: + tmp = "VarVals = " + field_path + "(V%iLB:V%iUB)"; + break; + case 2: + tmp = "VarVals = " + field_path + "(V%iLB:V%iUB,V%j)"; + break; + case 3: + tmp = "VarVals = " + field_path + "(V%iLB:V%iUB, V%j, V%k)"; + break; + case 4: + tmp = "VarVals = " + field_path + "(V%iLB:V%iUB, V%j, V%k, V%m)"; + break; + case 5: + tmp = "VarVals = " + field_path + "(V%iLB:V%iUB, V%j, V%k, V%m, V%n)"; + break; + } + w << indent << std::setw(71) << " " + tmp << " ! " + comment; + } + } + w << indent << "case default"; + w << indent << " VarVals = 0.0_R8Ki"; + w << indent << "end select"; + indent.erase(indent.size() - 3); + w << indent << "end associate"; + indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; + + //-------------------------------- + // Skip for Continuous state derivatives + //-------------------------------- + + if (short_type.compare("ContStateDeriv") == 0) + continue; + + //-------------------------------- + // Vars unpacking routine + //-------------------------------- + + indent = "\n"; + routine_name = mod.nickname + "_VarsUnpack" + short_type; + w << indent << "subroutine " << routine_name << "(Vars, ValAry, " << abbr << ")"; + indent += " "; + w << indent << "type(ModVarsType), intent(in) :: Vars"; + w << indent << "real(R8Ki), intent(in) :: ValAry(:)"; + w << indent << std::setw(40) << "type(" + ddt.type_fortran + "), intent(inout) " << ":: " + abbr; + w << indent << "integer(IntKi) :: i"; + w << indent << "do i = 1, size(Vars%" << abbr << ")"; + w << indent << " call " << mod.nickname + "_VarUnpack" + short_type + "(Vars%" << abbr << "(i), ValAry, " << abbr << ")"; + w << indent << "end do"; + indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; + + //-------------------------------- + // Var unpacking routine + //-------------------------------- + + w << indent << "subroutine " << mod.nickname + "_VarUnpack" + short_type + "(V, ValAry, " << abbr << ")"; + indent += " "; + w << indent << "type(ModVarType), intent(in) :: V"; + w << indent << "real(R8Ki), intent(in) :: ValAry(:)"; + w << indent << std::setw(40) << "type(" + ddt.type_fortran + "), intent(inout) " << ":: " << abbr; + w << indent << "associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2)))"; + indent += " "; + w << indent << "select case (DL%Num)"; + for (const auto &field : fields) + { + w << indent << "case (" << field.name << ")"; + std::string comment = "Scalar"; + auto field_path = field.desc; + if (field.rank > 0) + { + comment = std::string("Rank ") + std::to_string(field.rank) + " Array"; + } + if (field.name.compare("BD_x_q") == 0) + { + // This is a hack to convert BeamDyn's WM orientations to quaternions + w << indent << " if (V%Field == FieldOrientation) then"; + w << indent << " x%q(4:6, V%j) = wm_inv(quat_to_wm(VarVals)) ! Convert quaternion to WM parameters"; + w << indent << " else"; + w << indent << std::setw(71) << " " + field_path + "(V%iLB:V%iUB, V%j) = VarVals" << " ! Rank 2 Array"; + w << indent << " end if"; + } + else if (field.data_type->tag == DataType::Tag::Derived) + { + w << indent << std::setw(71) <<" call MV_UnpackMesh(V, ValAry, " + field_path + ")" << " ! Mesh"; + } + else + { + std::string tmp; + switch (field.rank) + { + case 0: + tmp = field_path + " = VarVals(1)"; + break; + case 1: + tmp = field_path + "(V%iLB:V%iUB) = VarVals"; + break; + case 2: + tmp = field_path + "(V%iLB:V%iUB, V%j) = VarVals"; + break; + case 3: + tmp = field_path + "(V%iLB:V%iUB, V%j, V%k) = VarVals"; + break; + case 4: + tmp = field_path + "(V%iLB:V%iUB, V%j, V%k, V%m) = VarVals"; + break; + case 5: + tmp = field_path + "(V%iLB:V%iUB, V%j, V%k, V%m, V%n) = VarVals"; + break; + } + w << indent << std::setw(71) << " " + tmp << " ! " + comment; + } + } + w << indent << "end select"; + indent.erase(indent.size() - 3); + w << indent << "end associate"; + indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; + + //-------------------------------- + // Field name routines + //-------------------------------- + + indent = "\n"; + routine_name = mod.nickname + "_" + tmp[0] + "FieldName"; + w << indent << "function " << routine_name << "(DL) result(Name)"; + indent += " "; + w << indent << "type(DatLoc), intent(in) :: DL"; + w << indent << "character(32) :: Name"; + w << indent << "select case (DL%Num)"; + for (const auto &field : fields) + { + std::string new_path(field.desc); + for (int j = 1; j < 5; ++j) + { + auto ind_str = "DL%i" + std::to_string(j); + auto ind = new_path.find(ind_str); + if (ind != std::string::npos) + { + new_path = new_path.substr(0, ind) + "\"//trim(Num2LStr(" + ind_str + "))//\"" + new_path.substr(ind + 5); + } + } + w << indent << "case (" << field.name << ")"; + w << indent << " Name = \"" << new_path << "\""; + } + w << indent << "case default"; + w << indent << " Name = \"Unknown Field\""; + w << indent << "end select"; + indent.erase(indent.size() - 3); + w << indent << "end function"; + w << indent; + } +} diff --git a/modules/openfast-registry/src/registry_parse.cpp b/modules/openfast-registry/src/registry_parse.cpp index e8ad7cdaf9..b0132ca2be 100644 --- a/modules/openfast-registry/src/registry_parse.cpp +++ b/modules/openfast-registry/src/registry_parse.cpp @@ -71,6 +71,23 @@ void Registry::parse(const std::string &file_name, const int recurse_level) auto module_name = has_slash ? fields_prev[1].substr(0, slash_index) : fields_prev[1]; this->use_modules.push_back(module_name); } + + // If this is not the root file, return + if (recurse_level != 0) + { + return; + } + + // Get the root module + std::shared_ptr mod; + for (auto &it : this->modules) + { + if (it.second->is_root) + { + mod = it.second; + break; + } + } } int Registry::parse_line(const std::string &line, std::vector &fields_prev, diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface.f90 index 3671b6266c..44a03d5734 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface.f90 @@ -375,8 +375,18 @@ SUBROUTINE Orca_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO m%PtfmFt = 0.0_ReKi m%LastTimeStep = -1.0_DbKi - InitOut%Ver = Orca_Ver + !............................................................................................ + ! Module Variables + !............................................................................................ + call Orca_InitVars(u, p, x, y, m, InitOut, .false., ErrStatTmp, ErrMsgTmp) + CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp + RETURN + END IF + + InitOut%Ver = Orca_Ver CONTAINS !------------------------------------------------------------------ @@ -391,6 +401,70 @@ END SUBROUTINE CleanUp END SUBROUTINE Orca_Init +!---------------------------------------------------------------------------------------------------------------------------------- + +subroutine Orca_InitVars(u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(Orca_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(Orca_ParameterType), intent(inout) :: p !< Parameters + type(Orca_ContinuousStateType), intent(inout) :: x !< Continuous state + type(Orca_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(Orca_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(Orca_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + logical, intent(in ) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'Orca_InitVars' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + integer(IntKi) :: i, j, Flags, idx + + ErrStat = ErrID_None + ErrMsg = "" + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Add pointers to vars to initialization output + InitOut%Vars => p%Vars + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + call MV_AddMeshVar(p%Vars%u, "PtfmMesh", MotionFields, DatLoc(Orca_u_PtfmMesh), & + Mesh=u%PtfmMesh) + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + call MV_AddMeshVar(p%Vars%y, 'PtfmMesh', LoadFields, DatLoc(Orca_y_PtfmMesh), & + Mesh=y%PtfmMesh) + + !---------------------------------------------------------------------------- + ! Initialize Variables and Values + !---------------------------------------------------------------------------- + + CALL MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine reads in the primary OrcaFlex Interface input file and places the values it reads in the InputFileData structure. !! It opens an echo file if requested. diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface.txt b/modules/orcaflex-interface/src/OrcaFlexInterface.txt index da75c894e1..feb8f7621b 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface.txt +++ b/modules/orcaflex-interface/src/OrcaFlexInterface.txt @@ -22,6 +22,7 @@ typedef ^ ^ ReKi TMax typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - typedef ^ ^ CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - +typedef ^ ^ ModVarsType *Vars - - - "Module Variables" # Inputfile information @@ -44,7 +45,8 @@ typedef ^ OtherStateType SiKi DummyOtherState - - - "Remov # ..... Misc/Optimization variables................................................................................................. # Define any data that are used only for efficiency purposes (these variables are not associated with time): # e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. -typedef ^ MiscVarType ReKi PtfmAM {6}{6} - - "Added mass matrix results from OrcaFlex" - +typedef ^ MiscVarType ModJacType Jac - - - "Jacobian matrices and arrays corresponding to module variables" +typedef ^ ^ ReKi PtfmAM {6}{6} - - "Added mass matrix results from OrcaFlex" - typedef ^ ^ ReKi PtfmFt {6} - - "Force/moment results from OrcaFlex" - typedef ^ ^ ReKi F_PtfmAM {6} - - "Force/moment results calculated from the added mass and accel" - typedef ^ ^ ReKi AllOuts : - - "An array holding the value of all of the calculated (not only selected) output channels" "see OutListParameters.xlsx spreadsheet" @@ -52,7 +54,10 @@ typedef ^ ^ DbKi LastTimeStep - - - # 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 ModVarsType &Vars - - - "Module Variables" +typedef ^ ^ IntKi iVarPtfmMeshU - - - "Index of platform mesh input variable" +typedef ^ ^ IntKi iVarPtfmMeshY - - - "Index of platform mesh output variable" +typedef ^ ^ DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds typedef ^ ^ DLL_Type DLL_Orca - - - "Info for the OrcaFlex DLL" - typedef ^ ^ CHARACTER(1024) SimNamePath - - - "Path with simulation rootname with null end character for passing to C" - typedef ^ ^ IntKi SimNamePathLen - - - "Length of SimNamePath (including null char)" - diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index 8b70866a69..7863272314 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -45,6 +45,7 @@ MODULE OrcaFlexInterface_Types TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] 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(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] END TYPE Orca_InitOutputType ! ======================= ! ========= Orca_InputFile ======= @@ -63,6 +64,7 @@ MODULE OrcaFlexInterface_Types ! ======================= ! ========= Orca_MiscVarType ======= TYPE, PUBLIC :: Orca_MiscVarType + TYPE(ModJacType) :: Jac !< Jacobian matrices and arrays corresponding to module variables [-] REAL(ReKi) , DIMENSION(1:6,1:6) :: PtfmAM = 0.0_ReKi !< Added mass matrix results from OrcaFlex [-] REAL(ReKi) , DIMENSION(1:6) :: PtfmFt = 0.0_ReKi !< Force/moment results from OrcaFlex [-] REAL(ReKi) , DIMENSION(1:6) :: F_PtfmAM = 0.0_ReKi !< Force/moment results calculated from the added mass and accel [-] @@ -72,6 +74,9 @@ MODULE OrcaFlexInterface_Types ! ======================= ! ========= Orca_ParameterType ======= TYPE, PUBLIC :: Orca_ParameterType + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] + INTEGER(IntKi) :: iVarPtfmMeshU = 0_IntKi !< Index of platform mesh input variable [-] + INTEGER(IntKi) :: iVarPtfmMeshY = 0_IntKi !< Index of platform mesh output variable [-] REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] TYPE(DLL_Type) :: DLL_Orca !< Info for the OrcaFlex DLL [-] CHARACTER(1024) :: SimNamePath !< Path with simulation rootname with null end character for passing to C [-] @@ -106,7 +111,13 @@ MODULE OrcaFlexInterface_Types REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Dummy placeholder [-] END TYPE Orca_ConstraintStateType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: Orca_x_Dummy = 1 ! Orca%Dummy + integer(IntKi), public, parameter :: Orca_z_DummyConstrState = 2 ! Orca%DummyConstrState + integer(IntKi), public, parameter :: Orca_u_PtfmMesh = 3 ! Orca%PtfmMesh + integer(IntKi), public, parameter :: Orca_y_PtfmMesh = 4 ! Orca%PtfmMesh + integer(IntKi), public, parameter :: Orca_y_WriteOutput = 5 ! Orca%WriteOutput + +contains subroutine Orca_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(Orca_InitInputType), intent(in) :: SrcInitInputData @@ -191,6 +202,7 @@ subroutine Orca_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt end if + DstInitOutputData%Vars => SrcInitOutputData%Vars end subroutine subroutine Orca_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -210,16 +222,25 @@ subroutine Orca_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%WriteOutputUnt)) then deallocate(InitOutputData%WriteOutputUnt) end if + nullify(InitOutputData%Vars) end subroutine subroutine Orca_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(Orca_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackInitOutput' + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call NWTC_Library_PackProgDesc(RF, InData%Ver) call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -230,10 +251,30 @@ subroutine Orca_UnPackInitOutput(RF, OutData) integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if end subroutine subroutine Orca_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) @@ -332,9 +373,13 @@ subroutine Orca_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) character(*), intent( out) :: ErrMsg integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Orca_CopyMisc' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return DstMiscData%PtfmAM = SrcMiscData%PtfmAM DstMiscData%PtfmFt = SrcMiscData%PtfmFt DstMiscData%F_PtfmAM = SrcMiscData%F_PtfmAM @@ -357,9 +402,13 @@ subroutine Orca_DestroyMisc(MiscData, ErrStat, ErrMsg) type(Orca_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Orca_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%AllOuts)) then deallocate(MiscData%AllOuts) end if @@ -370,6 +419,7 @@ subroutine Orca_PackMisc(RF, Indata) type(Orca_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackMisc' if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackModJacType(RF, InData%Jac) call RegPack(RF, InData%PtfmAM) call RegPack(RF, InData%PtfmFt) call RegPack(RF, InData%F_PtfmAM) @@ -386,6 +436,7 @@ subroutine Orca_UnPackMisc(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac call RegUnpack(RF, OutData%PtfmAM); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%PtfmFt); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%F_PtfmAM); if (RegCheckErr(RF, RoutineName)) return @@ -406,6 +457,20 @@ subroutine Orca_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Orca_CopyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if + DstParamData%iVarPtfmMeshU = SrcParamData%iVarPtfmMeshU + DstParamData%iVarPtfmMeshY = SrcParamData%iVarPtfmMeshY DstParamData%DT = SrcParamData%DT DstParamData%DLL_Orca = SrcParamData%DLL_Orca DstParamData%SimNamePath = SrcParamData%SimNamePath @@ -440,6 +505,12 @@ subroutine Orca_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Orca_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if call FreeDynamicLib( ParamData%DLL_Orca, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%OutParam)) then @@ -459,7 +530,17 @@ subroutine Orca_PackParam(RF, Indata) character(*), parameter :: RoutineName = 'Orca_PackParam' integer(B4Ki) :: i1 integer(B4Ki) :: LB(1), UB(1) + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if + call RegPack(RF, InData%iVarPtfmMeshU) + call RegPack(RF, InData%iVarPtfmMeshY) call RegPack(RF, InData%DT) call DLLTypePack(RF, InData%DLL_Orca) call RegPack(RF, InData%SimNamePath) @@ -485,7 +566,29 @@ subroutine Orca_UnPackParam(RF, OutData) integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if + call RegUnpack(RF, OutData%iVarPtfmMeshU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarPtfmMeshY); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return call DLLTypeUnpack(RF, OutData%DLL_Orca) ! DLL_Orca call RegUnpack(RF, OutData%SimNamePath); if (RegCheckErr(RF, RoutineName)) return @@ -1054,5 +1157,287 @@ SUBROUTINE Orca_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function Orca_InputMeshPointer(u, DL) result(Mesh) + type(Orca_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (Orca_u_PtfmMesh) + Mesh => u%PtfmMesh + end select +end function + +function Orca_OutputMeshPointer(y, DL) result(Mesh) + type(Orca_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (Orca_y_PtfmMesh) + Mesh => y%PtfmMesh + end select +end function + +subroutine Orca_VarsPackContState(Vars, x, ValAry) + type(Orca_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call Orca_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine Orca_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(Orca_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Orca_x_Dummy) + VarVals(1) = x%Dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Orca_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Orca_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call Orca_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine Orca_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Orca_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Orca_x_Dummy) + x%Dummy = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function Orca_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Orca_x_Dummy) + Name = "x%Dummy" + case default + Name = "Unknown Field" + end select +end function + +subroutine Orca_VarsPackContStateDeriv(Vars, x, ValAry) + type(Orca_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call Orca_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine Orca_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(Orca_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Orca_x_Dummy) + VarVals(1) = x%Dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Orca_VarsPackConstrState(Vars, z, ValAry) + type(Orca_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call Orca_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine Orca_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(Orca_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Orca_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Orca_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Orca_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call Orca_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine Orca_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Orca_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Orca_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function Orca_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Orca_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine Orca_VarsPackInput(Vars, u, ValAry) + type(Orca_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call Orca_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine Orca_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(Orca_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Orca_u_PtfmMesh) + call MV_PackMesh(V, u%PtfmMesh, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Orca_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Orca_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call Orca_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine Orca_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Orca_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Orca_u_PtfmMesh) + call MV_UnpackMesh(V, ValAry, u%PtfmMesh) ! Mesh + end select + end associate +end subroutine + +function Orca_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Orca_u_PtfmMesh) + Name = "u%PtfmMesh" + case default + Name = "Unknown Field" + end select +end function + +subroutine Orca_VarsPackOutput(Vars, y, ValAry) + type(Orca_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call Orca_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine Orca_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(Orca_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Orca_y_PtfmMesh) + call MV_PackMesh(V, y%PtfmMesh, ValAry) ! Mesh + case (Orca_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine Orca_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(Orca_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call Orca_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine Orca_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(Orca_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (Orca_y_PtfmMesh) + call MV_UnpackMesh(V, ValAry, y%PtfmMesh) ! Mesh + case (Orca_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function Orca_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (Orca_y_PtfmMesh) + Name = "y%PtfmMesh" + case (Orca_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE OrcaFlexInterface_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/CMakeLists.txt b/modules/seastate/CMakeLists.txt index f0860e89ef..3b3c5ebd01 100644 --- a/modules/seastate/CMakeLists.txt +++ b/modules/seastate/CMakeLists.txt @@ -37,7 +37,7 @@ add_library(seastlib STATIC src/SeaSt_WaveField_Types.f90 src/SeaState_Types.f90 ) -target_link_libraries(seastlib nwtclibs versioninfolib) +target_link_libraries(seastlib ifwlib nwtclibs versioninfolib) # Driver add_executable(seastate_driver diff --git a/modules/seastate/src/Current_Types.f90 b/modules/seastate/src/Current_Types.f90 index 3ed765adbd..373994e83e 100644 --- a/modules/seastate/src/Current_Types.f90 +++ b/modules/seastate/src/Current_Types.f90 @@ -58,7 +58,8 @@ MODULE Current_Types REAL(SiKi) :: PCurrVyiPz0 = 0.0_R4Ki !< [-] END TYPE Current_InitOutputType ! ======================= -CONTAINS + +contains subroutine Current_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(Current_InitInputType), intent(in) :: SrcInitInputData @@ -232,5 +233,7 @@ subroutine Current_UnPackInitOutput(RF, OutData) call RegUnpack(RF, OutData%PCurrVxiPz0); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%PCurrVyiPz0); if (RegCheckErr(RF, RoutineName)) return end subroutine + END MODULE Current_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index 0c1fb951e2..17092d3cf1 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -1,112 +1,68 @@ MODULE SeaSt_WaveField USE SeaSt_WaveField_Types +USE IfW_FlowField, only: IfW_FlowField_GetVelAcc IMPLICIT NONE PRIVATE ! Public functions and subroutines -PUBLIC WaveField_GetNodeWaveElev1 -PUBLIC WaveField_GetNodeWaveElev2 PUBLIC WaveField_GetNodeTotalWaveElev PUBLIC WaveField_GetNodeWaveNormal PUBLIC WaveField_GetNodeWaveKin PUBLIC WaveField_GetNodeWaveVel - +PUBLIC WaveField_GetNodeWaveVelAcc PUBLIC WaveField_GetWaveKin +PUBLIC WaveField_GetWaveVelAcc_AD public WaveField_Interp_Setup3D, WaveField_Interp_Setup4D CONTAINS !-------------------- Subroutine for wave elevation ------------------! -function WaveField_GetNodeWaveElev1( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg ) + +FUNCTION WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg, Elev1, Elev2 ) type(SeaSt_WaveFieldType), intent(in ) :: WaveField type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m real(DbKi), intent(in ) :: Time real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. integer(IntKi), intent( out) :: ErrStat ! Error status of the operation character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + real(SiKi), optional, intent( out) :: Elev1, Elev2 ! Elev1 and Elev2 components - real(SiKi) :: WaveField_GetNodeWaveElev1 - real(SiKi) :: Zeta - character(*), parameter :: RoutineName = 'WaveField_GetNodeWaveElev1' + real(SiKi) :: WaveField_GetNodeTotalWaveElev + real(SiKi) :: Zeta1, Zeta2 + character(*), parameter :: RoutineName = 'WaveField_GetNodeTotalWaveElev' integer(IntKi) :: errStat2 character(ErrMsgLen) :: errMsg2 ErrStat = ErrID_None ErrMsg = "" + IF (ALLOCATED(WaveField%WaveElev1) .or. ALLOCATED(WaveField%WaveElev2)) then + CALL WaveField_Interp_Setup3D(Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if + IF (ALLOCATED(WaveField%WaveElev1)) THEN - CALL WaveField_Interp_Setup3D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Zeta = WaveField_Interp_3D( WaveField%WaveElev1, WaveField_m ) + Zeta1 = WaveField_Interp_3D(WaveField%WaveElev1, WaveField_m) ELSE - Zeta = 0.0_SiKi + Zeta1 = 0.0_SiKi END IF - WaveField_GetNodeWaveElev1 = Zeta - -end function WaveField_GetNodeWaveElev1 - - -function WaveField_GetNodeWaveElev2( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg ) - type(SeaSt_WaveFieldType), intent(in ) :: WaveField - type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m - real(DbKi), intent(in ) :: Time - real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. - integer(IntKi), intent( out) :: ErrStat ! Error status of the operation - character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None - - real(SiKi) :: WaveField_GetNodeWaveElev2 - real(SiKi) :: Zeta - character(*), parameter :: RoutineName = 'WaveField_GetNodeWaveElev2' - integer(IntKi) :: errStat2 - character(ErrMsgLen) :: errMsg2 - - ErrStat = ErrID_None - ErrMsg = "" - IF (ALLOCATED(WaveField%WaveElev2)) THEN - CALL WaveField_Interp_Setup3D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Zeta = WaveField_Interp_3D( WaveField%WaveElev2, WaveField_m ) + Zeta2 = WaveField_Interp_3D(WaveField%WaveElev2, WaveField_m) ELSE - Zeta = 0.0_SiKi + Zeta2 = 0.0_SiKi END IF - WaveField_GetNodeWaveElev2 = Zeta - -end function WaveField_GetNodeWaveElev2 + if (present(Elev1)) Elev1 = Zeta1 + if (present(Elev2)) Elev2 = Zeta2 - -FUNCTION WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg ) - type(SeaSt_WaveFieldType), intent(in ) :: WaveField - type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m - real(DbKi), intent(in ) :: Time - real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. - integer(IntKi), intent( out) :: ErrStat ! Error status of the operation - character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None - - real(SiKi) :: WaveField_GetNodeTotalWaveElev - real(SiKi) :: Zeta1, Zeta2 - character(*), parameter :: RoutineName = 'WaveField_GetNodeTotalWaveElev' - integer(IntKi) :: errStat2 - character(ErrMsgLen) :: errMsg2 - - ErrStat = ErrID_None - ErrMsg = "" - - Zeta1 = WaveField_GetNodeWaveElev1( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; - Zeta2 = WaveField_GetNodeWaveElev2( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; WaveField_GetNodeTotalWaveElev = Zeta1 + Zeta2 -contains - logical function Failed() - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - end function END FUNCTION WaveField_GetNodeTotalWaveElev @@ -114,7 +70,7 @@ SUBROUTINE WaveField_GetNodeWaveNormal( WaveField, WaveField_m, Time, pos, r, n, type(SeaSt_WaveFieldType), intent(in ) :: WaveField type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m real(DbKi), intent(in ) :: Time - real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface normal is to be calculated. Third entry ignored if present. + real(ReKi), intent(in ) :: pos(:) ! Position at which free-surface normal is to be calculated. Third entry ignored if present. real(ReKi), intent(in ) :: r ! Distance for central differencing real(ReKi), intent( out) :: n(3) ! Free-surface normal vector integer(IntKi), intent( out) :: ErrStat ! Error status of the operation @@ -151,12 +107,13 @@ END SUBROUTINE WaveField_GetNodeWaveNormal !-------------------- Subroutine for full wave field kinematics --------------------! -SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNodeInWater, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) +SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNodeInWater, fetchDynCurrent, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) type(SeaSt_WaveFieldType), intent(in ) :: WaveField type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m real(DbKi), intent(in ) :: Time real(ReKi), intent(in ) :: pos(3) logical, intent(in ) :: forceNodeInWater + logical, intent(in ) :: fetchDynCurrent real(SiKi), intent( out) :: WaveElev1 real(SiKi), intent( out) :: WaveElev2 real(SiKi), intent( out) :: WaveElev @@ -168,7 +125,9 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNod integer(IntKi), intent( out) :: ErrStat ! Error status of the operation character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None - real(ReKi) :: posXY(2), posPrime(3), posXY0(3) + real(ReKi) :: posXY(2), posPrime(3), posXY0(3), PosOffset(3), posDummy(3,1) + integer(IntKi) :: startNode + real(ReKi), allocatable :: FV_DC(:,:), FA_DC(:,:) character(*), parameter :: RoutineName = 'WaveField_GetNodeWaveKin' integer(IntKi) :: errStat2 character(ErrMsgLen) :: errMsg2 @@ -180,10 +139,9 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNod posXY0 = (/pos(1),pos(2),0.0_ReKi/) FAMCF(:) = 0.0 - ! Wave elevation - WaveElev1 = WaveField_GetNodeWaveElev1( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; - WaveElev2 = WaveField_GetNodeWaveElev2( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; - WaveElev = WaveElev1 + WaveElev2 + ! Wave elevation (Calls WaveField_Interp_Setup3D internally so WaveField_Interp_3D can be used below) + WaveElev = WaveField_GetNodeTotalWaveElev(WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2, Elev1=WaveElev1, Elev2=WaveElev2) + if (Failed()) return IF (WaveField%WaveStMod == 0) THEN ! No wave stretching @@ -235,9 +193,8 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNod FAMCF(:) = WaveField_Interp_4D_vec( WaveField%WaveAccMCF, WaveField_m ) END IF - ! Extrapoled wave stretching + ! Extrapolated wave stretching IF (WaveField%WaveStMod == 2) THEN - CALL WaveField_Interp_Setup3D( Time, posXY, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; FV(:) = FV(:) + WaveField_Interp_3D_vec( WaveField%PWaveVel0, WaveField_m ) * pos(3) FA(:) = FA(:) + WaveField_Interp_3D_vec( WaveField%PWaveAcc0, WaveField_m ) * pos(3) FDynP = FDynP + WaveField_Interp_3D ( WaveField%PWaveDynP0, WaveField_m ) * pos(3) @@ -277,28 +234,48 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNod END IF ! If wave stretching is on or off + ! Get dynamic current velocity and acceleration + IF (fetchDynCurrent .AND. WaveField%hasCurrField) THEN + startNode = -1 + PosOffset = (/0.0_ReKi,0.0_ReKi,WaveField%EffWtrDpth/) + posDummy(:,1) = pos + ALLOCATE(FV_DC(3,1), STAT=ErrStat2); if (FailedMsg('Error allocating FV_DC')) return; + ALLOCATE(FA_DC(3,1), STAT=ErrStat2); if (FailedMsg('Error allocating FA_DC')) return; + CALL IfW_FlowField_GetVelAcc(WaveField%CurrField, startNode, Time, posDummy, FV_DC, FA_DC, ErrStat2, ErrMsg2, PosOffset=PosOffset); if (Failed()) return; + FV = FV + nodeInWater * FV_DC(:,1) + FA = FA + nodeInWater * FA_DC(:,1) + END IF + contains logical function Failed() call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) Failed = ErrStat >= AbortErrLev end function + logical function FailedMsg(ErrMsg2) + character(*), intent(in ) :: ErrMsg2 + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FailedMsg = ErrStat >= AbortErrLev + end function END SUBROUTINE WaveField_GetNodeWaveKin !-------------------- Subroutine for wave field velocity only --------------------! -SUBROUTINE WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos, forceNodeInWater, nodeInWater, FV, ErrStat, ErrMsg ) +SUBROUTINE WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos, forceNodeInWater, fetchDynCurrent, nodeInWater, FV, ErrStat, ErrMsg ) type(SeaSt_WaveFieldType), intent(in ) :: WaveField type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m real(DbKi), intent(in ) :: Time real(ReKi), intent(in ) :: pos(3) logical, intent(in ) :: forceNodeInWater + logical, intent(in ) :: fetchDynCurrent integer(IntKi), intent( out) :: nodeInWater real(SiKi), intent( out) :: FV(3) integer(IntKi), intent( out) :: ErrStat ! Error status of the operation character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None real(SiKi) :: WaveElev - real(ReKi) :: posXY(2), posPrime(3), posXY0(3) + real(ReKi) :: posXY(2), posPrime(3), posXY0(3), PosOffset(3), posDummy(3,1) + real(ReKi), allocatable :: FV_DC(:,:), FA_DC(:,:) + integer(IntKi) :: startNode character(*), parameter :: RoutineName = 'WaveField_GetNodeWaveVel' integer(IntKi) :: errStat2 character(ErrMsgLen) :: errMsg2 @@ -309,7 +286,7 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos, forceNod posXY = pos(1:2) posXY0 = (/pos(1),pos(2),0.0_ReKi/) - ! Wave elevation + ! Wave elevation (Calls WaveField_Interp_Setup3D internally so WaveField_Interp_3D_vec can be used below) WaveElev = WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; IF (WaveField%WaveStMod == 0) THEN ! No wave stretching @@ -344,9 +321,8 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos, forceNod CALL WaveField_Interp_Setup4D( Time, posXY0, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; FV(:) = WaveField_Interp_4D_vec( WaveField%WaveVel, WaveField_m ) - ! Extrapoled wave stretching + ! Extrapolated wave stretching IF (WaveField%WaveStMod == 2) THEN - CALL WaveField_Interp_Setup3D( Time, posXY, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; FV(:) = FV(:) + WaveField_Interp_3D_vec( WaveField%PWaveVel0, WaveField_m ) * pos(3) END IF @@ -374,20 +350,160 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos, forceNod END IF ! If wave stretching is on or off + ! Get dynamic current velocity + IF (fetchDynCurrent .AND. WaveField%hasCurrField) THEN + startNode = -1 + PosOffset = (/0.0_ReKi,0.0_ReKi,WaveField%EffWtrDpth/) + posDummy(:,1) = pos + ALLOCATE(FV_DC(3,1), STAT=ErrStat2); if (FailedMsg('Error allocating FV_DC')) return; + CALL IfW_FlowField_GetVelAcc(WaveField%CurrField, startNode, Time, posDummy, FV_DC, FA_DC, ErrStat2, ErrMsg2, PosOffset=PosOffset); if (Failed()) return; + FV = FV + nodeInWater * FV_DC(:,1) + END IF + contains logical function Failed() call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) Failed = ErrStat >= AbortErrLev end function + logical function FailedMsg(ErrMsg2) + character(*), intent(in ) :: ErrMsg2 + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FailedMsg = ErrStat >= AbortErrLev + end function END SUBROUTINE WaveField_GetNodeWaveVel -SUBROUTINE WaveField_GetWaveKin( WaveField, WaveField_m, Time, pos, forceNodeInWater, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) +SUBROUTINE WaveField_GetNodeWaveVelAcc( WaveField, WaveField_m, Time, pos, forceNodeInWater, fetchDynCurrent, nodeInWater, FV, FA, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(3) + logical, intent(in ) :: forceNodeInWater + logical, intent(in ) :: fetchDynCurrent + real(SiKi), intent( out) :: FV(3) + real(SiKi), intent( out) :: FA(3) + integer(IntKi), intent( out) :: nodeInWater + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + + real(SiKi) :: WaveElev + real(ReKi) :: posXY(2), posPrime(3), posXY0(3), PosOffset(3), posDummy(3,1) + integer(IntKi) :: startNode + real(ReKi), allocatable :: FV_DC(:,:), FA_DC(:,:) + character(*), parameter :: RoutineName = 'WaveField_GetNodeWaveVelAcc' + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + posXY = pos(1:2) + posXY0 = (/pos(1),pos(2),0.0_ReKi/) + + ! Wave elevation + WaveElev = WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; + + IF (WaveField%WaveStMod == 0) THEN ! No wave stretching + + IF ( pos(3) <= 0.0_ReKi) THEN ! Node is at or below the SWL + nodeInWater = 1_IntKi + ! Use location to obtain interpolated values of kinematics + CALL WaveField_Interp_Setup4D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) + FA(:) = WaveField_Interp_4D_Vec( WaveField%WaveAcc, WaveField_m ) + ELSE ! Node is above the SWL + nodeInWater = 0_IntKi + FV(:) = 0.0 + FA(:) = 0.0 + END IF + + ELSE ! Wave stretching enabled + + IF ( (pos(3) <= WaveElev) .OR. forceNodeInWater ) THEN ! Node is submerged + + nodeInWater = 1_IntKi + + IF ( WaveField%WaveStMod < 3 ) THEN ! Vertical or extrapolated wave stretching + + IF ( pos(3) <= 0.0_SiKi) THEN ! Node is below the SWL - evaluate wave dynamics as usual + + ! Use location to obtain interpolated values of kinematics + CALL WaveField_Interp_Setup4D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) + FA(:) = WaveField_Interp_4D_Vec( WaveField%WaveAcc, WaveField_m ) + + ELSE ! Node is above SWL - need wave stretching + + ! Vertical wave stretching + CALL WaveField_Interp_Setup4D( Time, posXY0, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_vec( WaveField%WaveVel, WaveField_m ) + FA(:) = WaveField_Interp_4D_vec( WaveField%WaveAcc, WaveField_m ) + + ! Extrapolated wave stretching + IF (WaveField%WaveStMod == 2) THEN + CALL WaveField_Interp_Setup3D( Time, posXY, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = FV(:) + WaveField_Interp_3D_vec( WaveField%PWaveVel0, WaveField_m ) * pos(3) + FA(:) = FA(:) + WaveField_Interp_3D_vec( WaveField%PWaveAcc0, WaveField_m ) * pos(3) + END IF + + END IF ! Node is above or below SWL + + ELSE ! Wheeler stretching - no need to check whether the node is above or below SWL + + ! Map the node z-position linearly from [-EffWtrDpth,m%WaveElev(j)] to [-EffWtrDpth,0] + posPrime = pos + posPrime(3) = WaveField%EffWtrDpth*(WaveField%EffWtrDpth+pos(3))/(WaveField%EffWtrDpth+WaveElev)-WaveField%EffWtrDpth + posPrime(3) = MIN( posPrime(3), 0.0_ReKi) ! Clamp z-position to zero. Needed when forceNodeInWater=.TRUE. + + ! Obtain the wave-field variables by interpolation with the mapped position. + CALL WaveField_Interp_Setup4D( Time, posPrime, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) + FA(:) = WaveField_Interp_4D_Vec( WaveField%WaveAcc, WaveField_m ) + + END IF ! Wave stretching method + + ELSE ! Node is out of water - zero-out all wave dynamics + + nodeInWater = 0_IntKi + FV(:) = 0.0 + FA(:) = 0.0 + + END IF ! If node is in or out of water + + END IF ! If wave stretching is on or off + + ! Get dynamic current velocity and acceleration + IF (fetchDynCurrent .AND. WaveField%hasCurrField) THEN + startNode = -1 + PosOffset = (/0.0_ReKi,0.0_ReKi,WaveField%EffWtrDpth/) + posDummy(:,1) = pos + ALLOCATE(FV_DC(3,1), STAT=ErrStat2); if (FailedMsg('Error allocating FV_DC')) return; + ALLOCATE(FA_DC(3,1), STAT=ErrStat2); if (FailedMsg('Error allocating FA_DC')) return; + CALL IfW_FlowField_GetVelAcc(WaveField%CurrField, startNode, Time, posDummy, FV_DC, FA_DC, ErrStat2, ErrMsg2, PosOffset=PosOffset); if (Failed()) return; + FV = FV + nodeInWater * FV_DC(:,1) + FA = FA + nodeInWater * FA_DC(:,1) + END IF + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function + logical function FailedMsg(ErrMsg2) + character(*), intent(in ) :: ErrMsg2 + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FailedMsg = ErrStat >= AbortErrLev + end function +END SUBROUTINE WaveField_GetNodeWaveVelAcc + + +SUBROUTINE WaveField_GetWaveKin( WaveField, WaveField_m, Time, pos, forceNodeInWater, fetchDynCurrent, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) type(SeaSt_WaveFieldType), intent(in ) :: WaveField type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m real(DbKi), intent(in ) :: Time real(ReKi), intent(in ) :: pos(:,:) logical, intent(in ) :: forceNodeInWater + logical, intent(in ) :: fetchDynCurrent real(SiKi), intent( out) :: WaveElev1(:) real(SiKi), intent( out) :: WaveElev2(:) real(SiKi), intent( out) :: WaveElev(:) @@ -403,15 +519,17 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, WaveField_m, Time, pos, forceNodeInW integer(IntKi) :: errStat2 character(ErrMsgLen) :: errMsg2 - integer(IntKi) :: NumPoints, i + integer(IntKi) :: NumPoints, i, startNode real(SiKi) :: FDynP_node, FV_node(3), FA_node(3), FAMCF_node(3) + real(ReKi) :: PosOffset(3) + real(ReKi), allocatable :: FV_DC(:,:), FA_DC(:,:) ErrStat = ErrID_None ErrMsg = "" NumPoints = size(pos, dim=2) DO i = 1, NumPoints - CALL WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos(:,i), forceNodeInWater, nodeInWater(i), WaveElev1(i), WaveElev2(i), WaveElev(i), FDynP_node, FV_node, FA_node, FAMCF_node, ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos(:,i), forceNodeInWater, .FALSE., nodeInWater(i), WaveElev1(i), WaveElev2(i), WaveElev(i), FDynP_node, FV_node, FA_node, FAMCF_node, ErrStat2, ErrMsg2 ) if (Failed()) return; FDynP(i) = REAL(FDynP_node,ReKi) FV(:, i) = REAL(FV_node, ReKi) @@ -421,14 +539,112 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, WaveField_m, Time, pos, forceNodeInW END IF END DO + ! If dynamic current field from IfW is present, get velocity and acceleration contributions + IF (fetchDynCurrent .AND. WaveField%hasCurrField) THEN + startNode = -1 + PosOffset = (/0.0_ReKi,0.0_ReKi,WaveField%EffWtrDpth/) + ALLOCATE(FV_DC( 3, NumPoints ), STAT=ErrStat2); if (FailedMsg('Error allocating FV_DC')) return; + ALLOCATE(FA_DC( 3, NumPoints ), STAT=ErrStat2); if (FailedMsg('Error allocating FA_DC')) return; + CALL IfW_FlowField_GetVelAcc(WaveField%CurrField, startNode, Time, pos, FV_DC, FA_DC, ErrStat2, ErrMsg2, PosOffset=PosOffset); if (Failed()) return; + + ! Add contributions from IfW current field if node is in water + DO i = 1, NumPoints + FV(:,i) = FV(:,i) + nodeInWater(i) * FV_DC(:,i) + FA(:,i) = FA(:,i) + nodeInWater(i) * FA_DC(:,i) + END DO + + END IF + contains logical function Failed() call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) Failed = ErrStat >= AbortErrLev end function + logical function FailedMsg(ErrMsg2) + character(*), intent(in ) :: ErrMsg2 + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FailedMsg = ErrStat >= AbortErrLev + end function end subroutine WaveField_GetWaveKin +! This subroutine is intended for AeroDyn when modeling MHK turbines +SUBROUTINE WaveField_GetWaveVelAcc_AD( WaveField, WaveField_m, StartNode, Time, pos, FV, FA, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + integer(IntKi), intent(in ) :: StartNode + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(:,:) ! z=0 at MSL + real(ReKi), intent( out) :: FV(:,:) + real(ReKi), allocatable, intent(inout) :: FA(:,:) + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + integer(IntKi), allocatable :: nodeInWater(:) + integer(IntKi) :: NumPoints, i + real(SiKi) :: FV_node(3), FA_node(3) + real(ReKi) :: PosOffset(3), MSL2SWL, WtrDpth + real(ReKi), allocatable :: FV_DC(:,:), FA_DC(:,:) + logical :: getAcc + character(*), parameter :: RoutineName = 'WaveField_GetWaveVelAcc_AD' + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + MSL2SWL = WaveField%MSL2SWL + WtrDpth = WaveField%EffWtrDpth - MSL2SWL + getAcc = ALLOCATED(FA) + NumPoints = size(pos, dim=2) + + ALLOCATE( nodeInWater(NumPoints), STAT=ErrStat2); if (FailedMsg('Error allocating nodeInWater')) return; + + ! Note: SeaState wavefield grid has z=0 on the SWL + IF (getAcc) THEN + DO i = 1, NumPoints + CALL WaveField_GetNodeWaveVelAcc( WaveField, WaveField_m, Time, pos(:,i)-(/0.0,0.0,MSL2SWL/), .FALSE., .FALSE., nodeInWater(i), FV_node, FA_node, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:, i) = REAL(FV_node, ReKi) + FA(:, i) = REAL(FA_node, ReKi) + END DO + ELSE + DO i = 1, NumPoints + CALL WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos(:,i)-(/0.0,0.0,MSL2SWL/), .FALSE., .FALSE., nodeInWater(i), FV_node, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:, i) = REAL(FV_node, ReKi) + END DO + END IF + + ! If dynamic current field from IfW is present, get velocity and acceleration contributions + IF (WaveField%hasCurrField) THEN + PosOffset = (/0.0_ReKi,0.0_ReKi,WtrDpth/) ! IfW FlowField grid effectively has z=0 on the seabed + ALLOCATE(FV_DC( 3, NumPoints ), STAT=ErrStat2); if (FailedMsg('Error allocating FV_DC')) return; + IF (getAcc) THEN + ALLOCATE(FA_DC( 3, NumPoints ), STAT=ErrStat2); if (FailedMsg('Error allocating FA_DC')) return; + END IF + CALL IfW_FlowField_GetVelAcc(WaveField%CurrField, StartNode, Time, pos, FV_DC, FA_DC, ErrStat2, ErrMsg2, PosOffset=PosOffset); if (Failed()) return; + + ! Add contributions from IfW current field if node is in water + DO i = 1, NumPoints + FV(:,i) = FV(:,i) + nodeInWater(i) * FV_DC(:,i) + END DO + IF (getAcc) THEN + DO i = 1, NumPoints + FA(:,i) = FA(:,i) + nodeInWater(i) * FA_DC(:,i) + END DO + END IF + END IF + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function + logical function FailedMsg(ErrMsg2) + character(*), intent(in ) :: ErrMsg2 + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FailedMsg = ErrStat >= AbortErrLev + end function +END SUBROUTINE WaveField_GetWaveVelAcc_AD + !---------------------------------------------------------------------------------------------------- ! Interpolation related functions !---------------------------------------------------------------------------------------------------- @@ -462,9 +678,17 @@ subroutine SetCartesianXYIndex(p, pZero, delta, nMax, Indx_Lo, Indx_Hi, isopc, F end if Tmp = (p-pZero) / delta - Indx_Lo = INT( Tmp ) + 1 ! convert REAL to INTEGER, then add one since our grid indices start at 1, not 0 - isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo - 1, ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 - + Indx_Lo = INT( Tmp ) + 1 ! convert REAL to INTEGER, then add one since our grid indices start at 1, not 0 + + ! Calculate isoparametric coordinate and clamp between -1 and 1 + isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo - 1, ReKi)) - 1.0_ReKi + if (isopc < -1.0_SiKi) then + isopc = -1.0_SiKi + else if (isopc > 1.0_SiKi) then + isopc = 1.0_SiKi + end if + + ! Check that lower index is valid if ( Indx_Lo < 1 ) then Indx_Lo = 1 isopc = -1.0 @@ -474,8 +698,10 @@ subroutine SetCartesianXYIndex(p, pZero, delta, nMax, Indx_Lo, Indx_Hi, isopc, F end if end if - Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, zero-based - + ! Calculate hi grid index + Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, zero-based + + ! Check that upper index is valid if ( Indx_Lo >= Indx_Hi ) then ! Need to clamp to grid boundary if (FirstWarn .and. Indx_Lo /= Indx_Hi) then ! don't warn if we are exactly at the boundary @@ -486,12 +712,6 @@ subroutine SetCartesianXYIndex(p, pZero, delta, nMax, Indx_Lo, Indx_Hi, isopc, F isopc = 1.0 end if - !------------------------------------------------------------------------------------------------- - ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) - !------------------------------------------------------------------------------------------------- - isopc = min( 1.0_SiKi, isopc ) - isopc = max(-1.0_SiKi, isopc ) - end subroutine SetCartesianXYIndex @@ -521,7 +741,14 @@ subroutine SetCartesianZIndex(p, z_depth, delta, nMax, Indx_Lo, Indx_Hi, isopc, Tmp = acos( max(-1.0_ReKi, min(1.0_ReKi, 1+(p / z_depth)) ) ) / delta Tmp = nmax - 1 - Tmp Indx_Lo = INT( Tmp ) + 1 ! convert REAL to INTEGER, then add one since our grid indices start at 1, not 0 - isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo - 1, ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 + + ! Calculate isoparametric coordinate and clamp between -1 and 1 + isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo - 1, ReKi)) - 1.0_ReKi + if (isopc < -1.0_SiKi) then + isopc = -1.0_SiKi + else if (isopc > 1.0_SiKi) then + isopc = 1.0_SiKi + end if if ( Indx_Lo < 1 ) then Indx_Lo = 1 @@ -544,12 +771,6 @@ subroutine SetCartesianZIndex(p, z_depth, delta, nMax, Indx_Lo, Indx_Hi, isopc, isopc = 1.0 end if - !------------------------------------------------------------------------------------------------- - ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) - !------------------------------------------------------------------------------------------------- - isopc = min( 1.0_SiKi, isopc ) - isopc = max(-1.0_SiKi, isopc ) - end subroutine SetCartesianZIndex @@ -571,10 +792,10 @@ subroutine SetTimeIndex(Time, deltaT, nMax, Indx_Lo, Indx_Hi, isopc, ErrStat, Er isopc = -1.0 Indx_Lo = 0 Indx_Hi = 0 - if ( Time < 0.0_DbKi ) then - CALL SetErrStat(ErrID_Fatal,'Time value must be greater than or equal to zero!',ErrStat,ErrMsg,'SetTimeIndex') !error out if time is outside the lower bounds - RETURN - end if + !if ( Time < 0.0_DbKi ) then + ! CALL SetErrStat(ErrID_Fatal,'Time value must be greater than or equal to zero!',ErrStat,ErrMsg,'SetTimeIndex') !error out if time is outside the lower bounds + ! RETURN + !end if ! if there are no timesteps, don't proceed if (EqualRealNos(deltaT,0.0_ReKi) .or. deltaT < 0.0_ReKi) return; @@ -585,16 +806,16 @@ subroutine SetTimeIndex(Time, deltaT, nMax, Indx_Lo, Indx_Hi, isopc, ErrStat, Er ! wrap it back to index 0, if Indx_Lo = 11 we want to wrap back to index 1. Tmp = real( (Time/ real(deltaT,DbKi)) ,ReKi) - Tmp = MOD(Tmp,real((nMax), ReKi)) + Tmp = MODULO(Tmp,real((nMax), ReKi)) Indx_Lo = INT( Tmp ) ! convert REAL to INTEGER - isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo , ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 - - !------------------------------------------------------------------------------------------------- - ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) - !------------------------------------------------------------------------------------------------- - isopc = min( 1.0_SiKi, isopc ) - isopc = max(-1.0_SiKi, isopc ) + ! Calculate isoparametric coordinate and clamp between -1 and 1 + isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo, ReKi)) - 1.0_ReKi + if (isopc < -1.0_SiKi) then + isopc = -1.0_SiKi + else if (isopc > 1.0_SiKi) then + isopc = 1.0_SiKi + end if Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, zero-based @@ -616,6 +837,8 @@ subroutine WaveField_Interp_Setup4D( Time, Position, p, m, ErrStat, ErrMsg ) character(*), parameter :: RoutineName = 'WaveField_Interp_Setup4D' integer(IntKi) :: i real(SiKi) :: isopc(4) ! isoparametric coordinates + real(SiKi) :: one_m_isopc(4) ! 1 - isoparametric coordinates + real(SiKi) :: one_p_isopc(4) ! 1 + isoparametric coordinates integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 @@ -642,24 +865,27 @@ subroutine WaveField_Interp_Setup4D( Time, Position, p, m, ErrStat, ErrMsg ) if (Failed()) return; end if + ! Calculate 1+ and 1- isoparametric coordinates to avoid recalculations + one_m_isopc = 1.0_SiKi - isopc + one_p_isopc = 1.0_SiKi + isopc + ! compute weighting factors - m%N4D( 1) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D( 2) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D( 3) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D( 4) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D( 5) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D( 6) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D( 7) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D( 8) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D( 9) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D(10) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D(11) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D(12) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D(13) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D(14) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D(15) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D(16) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D = m%N4D / REAL( SIZE(m%N4D), SiKi ) ! normalize + m%N4D( 1) = one_m_isopc(1) * one_m_isopc(2) * one_m_isopc(3) * one_m_isopc(4) / 16.0_SiKi + m%N4D( 2) = one_p_isopc(1) * one_m_isopc(2) * one_m_isopc(3) * one_m_isopc(4) / 16.0_SiKi + m%N4D( 3) = one_m_isopc(1) * one_p_isopc(2) * one_m_isopc(3) * one_m_isopc(4) / 16.0_SiKi + m%N4D( 4) = one_p_isopc(1) * one_p_isopc(2) * one_m_isopc(3) * one_m_isopc(4) / 16.0_SiKi + m%N4D( 5) = one_m_isopc(1) * one_m_isopc(2) * one_p_isopc(3) * one_m_isopc(4) / 16.0_SiKi + m%N4D( 6) = one_p_isopc(1) * one_m_isopc(2) * one_p_isopc(3) * one_m_isopc(4) / 16.0_SiKi + m%N4D( 7) = one_m_isopc(1) * one_p_isopc(2) * one_p_isopc(3) * one_m_isopc(4) / 16.0_SiKi + m%N4D( 8) = one_p_isopc(1) * one_p_isopc(2) * one_p_isopc(3) * one_m_isopc(4) / 16.0_SiKi + m%N4D( 9) = one_m_isopc(1) * one_m_isopc(2) * one_m_isopc(3) * one_p_isopc(4) / 16.0_SiKi + m%N4D(10) = one_p_isopc(1) * one_m_isopc(2) * one_m_isopc(3) * one_p_isopc(4) / 16.0_SiKi + m%N4D(11) = one_m_isopc(1) * one_p_isopc(2) * one_m_isopc(3) * one_p_isopc(4) / 16.0_SiKi + m%N4D(12) = one_p_isopc(1) * one_p_isopc(2) * one_m_isopc(3) * one_p_isopc(4) / 16.0_SiKi + m%N4D(13) = one_m_isopc(1) * one_m_isopc(2) * one_p_isopc(3) * one_p_isopc(4) / 16.0_SiKi + m%N4D(14) = one_p_isopc(1) * one_m_isopc(2) * one_p_isopc(3) * one_p_isopc(4) / 16.0_SiKi + m%N4D(15) = one_m_isopc(1) * one_p_isopc(2) * one_p_isopc(3) * one_p_isopc(4) / 16.0_SiKi + m%N4D(16) = one_p_isopc(1) * one_p_isopc(2) * one_p_isopc(3) * one_p_isopc(4) / 16.0_SiKi contains logical function Failed() @@ -679,7 +905,9 @@ subroutine WaveField_Interp_Setup3D( Time, Position, p, m, ErrStat, ErrMsg ) character(*), parameter :: RoutineName = 'WaveField_Interp_Setup3D' integer(IntKi) :: i - real(SiKi) :: isopc(4) ! isoparametric coordinates + real(SiKi) :: isopc(3) ! isoparametric coordinates + real(SiKi) :: one_m_isopc(3) ! 1 - isoparametric coordinates + real(SiKi) :: one_p_isopc(3) ! 1 + isoparametric coordinates integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 @@ -696,16 +924,19 @@ subroutine WaveField_Interp_Setup3D( Time, Position, p, m, ErrStat, ErrMsg ) if (Failed()) return; enddo + ! Calculate 1+ and 1- isoparametric coordinates to avoid recalculations + one_m_isopc = 1.0_SiKi - isopc + one_p_isopc = 1.0_SiKi + isopc + ! compute weighting factors - m%N3D(1) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - m%N3D(2) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - m%N3D(3) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - m%N3D(4) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - m%N3D(5) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - m%N3D(6) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - m%N3D(7) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - m%N3D(8) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - m%N3D = m%N3D / REAL( SIZE(m%N3D), ReKi ) ! normalize + m%N3D(1) = one_m_isopc(1) * one_m_isopc(2) * one_m_isopc(3) / 8.0_SiKi + m%N3D(2) = one_p_isopc(1) * one_m_isopc(2) * one_m_isopc(3) / 8.0_SiKi + m%N3D(3) = one_m_isopc(1) * one_p_isopc(2) * one_m_isopc(3) / 8.0_SiKi + m%N3D(4) = one_p_isopc(1) * one_p_isopc(2) * one_m_isopc(3) / 8.0_SiKi + m%N3D(5) = one_m_isopc(1) * one_m_isopc(2) * one_p_isopc(3) / 8.0_SiKi + m%N3D(6) = one_p_isopc(1) * one_m_isopc(2) * one_p_isopc(3) / 8.0_SiKi + m%N3D(7) = one_m_isopc(1) * one_p_isopc(2) * one_p_isopc(3) / 8.0_SiKi + m%N3D(8) = one_p_isopc(1) * one_p_isopc(2) * one_p_isopc(3) / 8.0_SiKi contains logical function Failed() @@ -723,26 +954,25 @@ function WaveField_Interp_4D( pKinXX, m ) type(SeaSt_WaveField_MiscVarType), intent(in ) :: m real(SiKi) :: WaveField_Interp_4D - real(SiKi) :: u(16) ! size 2^n ! interpolate - u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) - u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) - u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) - u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4) ) - u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) - u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) - u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) - u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) - u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) - u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4) ) - u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) - u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) - u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - WaveField_Interp_4D = SUM ( m%N4D * u ) + WaveField_Interp_4D = & + m%N4D( 1) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) + & + m%N4D( 2) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) + & + m%N4D( 3) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4) ) + & + m%N4D( 4) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4) ) + & + m%N4D( 5) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) + & + m%N4D( 6) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) + & + m%N4D( 7) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) + & + m%N4D( 8) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) + & + m%N4D( 9) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) + & + m%N4D(10) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) + & + m%N4D(11) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) + & + m%N4D(12) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) + & + m%N4D(13) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) + & + m%N4D(14) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) + & + m%N4D(15) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) + & + m%N4D(16) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) end function WaveField_Interp_4D @@ -754,28 +984,27 @@ function WaveField_Interp_4D_Vec( pKinXX, m) type(SeaSt_WaveField_MiscVarType), intent(in ) :: m !< misc vars for interpolation real(SiKi) :: WaveField_Interp_4D_Vec(3) - real(SiKi) :: u(16) ! size 2^n integer(IntKi) :: iDir ! interpolate do iDir = 1,3 - u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - WaveField_Interp_4D_Vec(iDir) = SUM ( m%N4D * u ) + WaveField_Interp_4D_Vec(iDir) = & + m%N4D( 1) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 2) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 3) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 4) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 5) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 6) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 7) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 8) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 9) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + & + m%N4D(10) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + & + m%N4D(11) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + & + m%N4D(12) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + & + m%N4D(13) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + & + m%N4D(14) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + & + m%N4D(15) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + & + m%N4D(16) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) end do END FUNCTION WaveField_Interp_4D_Vec @@ -788,28 +1017,27 @@ function WaveField_Interp_4D_Vec6( pKinXX, m) type(SeaSt_WaveField_MiscVarType), intent(in ) :: m !< misc vars for interpolation real(SiKi) :: WaveField_Interp_4D_Vec6(6) - real(SiKi) :: u(16) ! size 2^n integer(IntKi) :: iDir ! interpolate do iDir = 1,6 - u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - WaveField_Interp_4D_Vec6(iDir) = SUM ( m%N4D * u ) + WaveField_Interp_4D_Vec6(iDir) = & + m%N4D( 1) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 2) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 3) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 4) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 5) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 6) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 7) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 8) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + & + m%N4D( 9) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + & + m%N4D(10) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + & + m%N4D(11) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + & + m%N4D(12) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + & + m%N4D(13) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + & + m%N4D(14) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + & + m%N4D(15) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + & + m%N4D(16) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) end do END FUNCTION WaveField_Interp_4D_Vec6 @@ -824,19 +1052,18 @@ function WaveField_Interp_3D( pKinXX, m ) character(*), parameter :: RoutineName = 'WaveField_Interp_3D' real(SiKi) :: WaveField_Interp_3D - real(SiKi) :: u(8) integer(IntKi) :: i ! interpolate - u(1) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3) ) - u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3) ) - u(3) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3) ) - u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3) ) - u(5) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3) ) - u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3) ) - u(7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3) ) - u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3) ) - WaveField_Interp_3D = SUM ( m%N3D * u ) + WaveField_Interp_3D = & + m%N3D(1) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3) ) + & + m%N3D(2) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3) ) + & + m%N3D(3) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3) ) + & + m%N3D(4) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3) ) + & + m%N3D(5) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3) ) + & + m%N3D(6) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3) ) + & + m%N3D(7) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3) ) + & + m%N3D(8) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3) ) end function WaveField_Interp_3D @@ -844,22 +1071,20 @@ FUNCTION WaveField_Interp_3D_VEC( pKinXX, m ) real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) !< 3D Wave excitation data (SiKi for storage space reasons) type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< MiscVars - character(*), parameter :: RoutineName = 'WaveField_Interp_3D_VEC' real(SiKi) :: WaveField_Interp_3D_VEC(3) - real(SiKi) :: u(8) integer(IntKi) :: i ! interpolate do i = 1,3 - u(1) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) - u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) - u(3) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) - u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) - u(5) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) - u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) - u(7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) - u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) - WaveField_Interp_3D_VEC(i) = SUM ( m%N3D * u ) + WaveField_Interp_3D_VEC(i) = & + m%N3D(1) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) + & + m%N3D(2) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) + & + m%N3D(3) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) + & + m%N3D(4) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) + & + m%N3D(5) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) + & + m%N3D(6) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) + & + m%N3D(7) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) + & + m%N3D(8) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) end do end function WaveField_Interp_3D_VEC @@ -868,25 +1093,21 @@ function Wavefield_Interp_3D_VEC6( pKinXX, m ) real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) !< 3D Wave excitation data (SiKi for storage space reasons) type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< Miscvars - character(*), parameter :: RoutineName = 'Wavefield_Interp_3D_VEC6' real(SiKi) :: Wavefield_Interp_3D_VEC6(6) - real(SiKi) :: u(8) integer(IntKi) :: i ! interpolate do i = 1,6 - u(1) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) - u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) - u(3) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) - u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) - u(5) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) - u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) - u(7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) - u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) - Wavefield_Interp_3D_VEC6(i) = SUM ( m%N3D * u ) + Wavefield_Interp_3D_VEC6(i) = & + m%N3D(1) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) + & + m%N3D(2) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) + & + m%N3D(3) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) + & + m%N3D(4) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) + & + m%N3D(5) * pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) + & + m%N3D(6) * pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) + & + m%N3D(7) * pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) + & + m%N3D(8) * pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) end do end function Wavefield_Interp_3D_VEC6 - - END MODULE SeaSt_WaveField diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt index f5730bc868..dd298cfe4e 100644 --- a/modules/seastate/src/SeaSt_WaveField.txt +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -1,6 +1,8 @@ #--------------------------------------------------------------------------------------------------------------------------------------------------------- # Data structures for representing wave fields. # +usefrom IfW_FlowField.txt + param SeaSt_WaveField - INTEGER WaveDirMod_None - 0 - "WaveDirMod = 0 [Directional spreading function is NONE]" - param SeaSt_WaveField - INTEGER WaveDirMod_COS2S - 1 - "WaveDirMod = 1 [Directional spreading function is COS2S]" - @@ -52,6 +54,8 @@ typedef ^ ^ ReKi MSL2SWL typedef ^ ^ SiKi WaveElevC {:}{:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (m) typedef ^ ^ SiKi WaveElevC0 {:}{:} - - "Fourier components of the incident wave elevation at the platform reference point. First column is the real part; second column is the imaginary part" (m) typedef ^ ^ SiKi WaveDirArr {:} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1" (degrees) +typedef ^ ^ LOGICAL hasCurrField - - - "True if CurrField is populated for MHK simulations" (-) +typedef ^ ^ FlowFieldType *CurrField - - - "Pointer to FlowField type from InflowWind containing the dynamic current information" (-) typedef ^ ^ ReKi WtrDpth - - - "Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default)" (m) typedef ^ ^ ReKi WtrDens - - - "Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default)" (kg/m^3) diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 4654a04040..222a0c2376 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -31,22 +31,23 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE SeaSt_WaveField_Types !--------------------------------------------------------------------------------------------------------------------------------- +USE IfW_FlowField_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: WaveDirMod_None = 0 ! WaveDirMod = 0 [Directional spreading function is NONE] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WaveDirMod_COS2S = 1 ! WaveDirMod = 1 [Directional spreading function is COS2S] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_None = 0 ! WaveMod = 0 [Incident wave kinematics model: NONE (still water)] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_Regular = 1 ! WaveMod = 1 [Incident wave kinematics model: Regular (periodic)] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_RegularUsrPh = 10 ! WaveMod = 1P# [Incident wave kinematics model: Regular (user specified phase)] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_JONSWAP = 2 ! WaveMod = 2 [Incident wave kinematics model: JONSWAP/Pierson-Moskowitz spectrum (irregular)] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_WhiteNoise = 3 ! WaveMod = 3 [Incident wave kinematics model: White noise spectrum (irregular)] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_UserSpctrm = 4 ! WaveMod = 4 [Incident wave kinematics model: user-defined spectrum from routine UserWaveSpctrm (irregular)] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_ExtElev = 5 ! WaveMod = 5 [Incident wave kinematics model: Externally generated wave-elevation time series] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_ExtFull = 6 ! WaveMod = 6 [Incident wave kinematics model: Externally generated full wave-kinematics time series (invalid for PotMod/=0)] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_UserFreq = 7 ! WaveMod = 7 [Incident wave kinematics model: user-defined wave frequency components] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ConstWaveMod_None = 0 ! ConstWaveMod = 0 [Constrained wave model: No constrained waves] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ConstWaveMod_CrestElev = 1 ! ConstWaveMod = 1 [Constrained wave model: Constrained wave with specified crest elevation, alpha] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: ConstWaveMod_Peak2Trough = 2 ! ConstWaveMod = 2 [Constrained wave model: Constrained wave with guaranteed peak-to-trough crest height, HCrest] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveDirMod_None = 0 ! WaveDirMod = 0 [Directional spreading function is NONE] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveDirMod_COS2S = 1 ! WaveDirMod = 1 [Directional spreading function is COS2S] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_None = 0 ! WaveMod = 0 [Incident wave kinematics model: NONE (still water)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_Regular = 1 ! WaveMod = 1 [Incident wave kinematics model: Regular (periodic)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_RegularUsrPh = 10 ! WaveMod = 1P# [Incident wave kinematics model: Regular (user specified phase)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_JONSWAP = 2 ! WaveMod = 2 [Incident wave kinematics model: JONSWAP/Pierson-Moskowitz spectrum (irregular)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_WhiteNoise = 3 ! WaveMod = 3 [Incident wave kinematics model: White noise spectrum (irregular)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_UserSpctrm = 4 ! WaveMod = 4 [Incident wave kinematics model: user-defined spectrum from routine UserWaveSpctrm (irregular)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_ExtElev = 5 ! WaveMod = 5 [Incident wave kinematics model: Externally generated wave-elevation time series] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_ExtFull = 6 ! WaveMod = 6 [Incident wave kinematics model: Externally generated full wave-kinematics time series (invalid for PotMod/=0)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_UserFreq = 7 ! WaveMod = 7 [Incident wave kinematics model: user-defined wave frequency components] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ConstWaveMod_None = 0 ! ConstWaveMod = 0 [Constrained wave model: No constrained waves] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ConstWaveMod_CrestElev = 1 ! ConstWaveMod = 1 [Constrained wave model: Constrained wave with specified crest elevation, alpha] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ConstWaveMod_Peak2Trough = 2 ! ConstWaveMod = 2 [Constrained wave model: Constrained wave with guaranteed peak-to-trough crest height, HCrest] [-] ! ========= SeaSt_WaveField_ParameterType ======= TYPE, PUBLIC :: SeaSt_WaveField_ParameterType INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of evenly-spaced grid points in the t, x, y, and z directions [-] @@ -85,6 +86,8 @@ MODULE SeaSt_WaveField_Types REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevC !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(m)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevC0 !< Fourier components of the incident wave elevation at the platform reference point. First column is the real part; second column is the imaginary part [(m)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveDirArr !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] + LOGICAL :: hasCurrField = .false. !< True if CurrField is populated for MHK simulations [(-)] + TYPE(FlowFieldType) , POINTER :: CurrField => NULL() !< Pointer to FlowField type from InflowWind containing the dynamic current information [(-)] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default) [(m)] REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default) [(kg/m^3)] REAL(SiKi) :: RhoXg = 0.0_R4Ki !< = WtrDens*Gravity [-] @@ -105,7 +108,8 @@ MODULE SeaSt_WaveField_Types INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] END TYPE SeaSt_WaveFieldType ! ======================= -CONTAINS + +contains subroutine SeaSt_WaveField_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) type(SeaSt_WaveField_ParameterType), intent(in) :: SrcParamData @@ -402,6 +406,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D end if DstSeaSt_WaveFieldTypeData%WaveDirArr = SrcSeaSt_WaveFieldTypeData%WaveDirArr end if + DstSeaSt_WaveFieldTypeData%hasCurrField = SrcSeaSt_WaveFieldTypeData%hasCurrField + DstSeaSt_WaveFieldTypeData%CurrField => SrcSeaSt_WaveFieldTypeData%CurrField DstSeaSt_WaveFieldTypeData%WtrDpth = SrcSeaSt_WaveFieldTypeData%WtrDpth DstSeaSt_WaveFieldTypeData%WtrDens = SrcSeaSt_WaveFieldTypeData%WtrDens DstSeaSt_WaveFieldTypeData%RhoXg = SrcSeaSt_WaveFieldTypeData%RhoXg @@ -478,12 +484,14 @@ subroutine SeaSt_WaveField_DestroySeaSt_WaveFieldType(SeaSt_WaveFieldTypeData, E if (allocated(SeaSt_WaveFieldTypeData%WaveDirArr)) then deallocate(SeaSt_WaveFieldTypeData%WaveDirArr) end if + nullify(SeaSt_WaveFieldTypeData%CurrField) end subroutine subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, Indata) type(RegFile), intent(inout) :: RF type(SeaSt_WaveFieldType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_WaveField_PackSeaSt_WaveFieldType' + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%WaveTime) call RegPackAlloc(RF, InData%WaveDynP) @@ -504,6 +512,14 @@ subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, Indata) call RegPackAlloc(RF, InData%WaveElevC) call RegPackAlloc(RF, InData%WaveElevC0) call RegPackAlloc(RF, InData%WaveDirArr) + call RegPack(RF, InData%hasCurrField) + call RegPack(RF, associated(InData%CurrField)) + if (associated(InData%CurrField)) then + call RegPackPointer(RF, c_loc(InData%CurrField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(RF, InData%CurrField) + end if + end if call RegPack(RF, InData%WtrDpth) call RegPack(RF, InData%WtrDens) call RegPack(RF, InData%RhoXg) @@ -532,6 +548,8 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(RF, OutData) integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%WaveTime); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WaveDynP); if (RegCheckErr(RF, RoutineName)) return @@ -552,6 +570,25 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(RF, OutData) call RegUnpackAlloc(RF, OutData%WaveElevC); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WaveElevC0); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WaveDirArr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%hasCurrField); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%CurrField)) deallocate(OutData%CurrField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%CurrField) + else + allocate(OutData%CurrField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%CurrField) + call IfW_FlowField_UnpackFlowFieldType(RF, OutData%CurrField) ! CurrField + end if + else + OutData%CurrField => null() + end if call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%WtrDens); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%RhoXg); if (RegCheckErr(RF, RoutineName)) return @@ -571,5 +608,7 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(RF, OutData) call RegUnpack(RF, OutData%NStepWave); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NStepWave2); if (RegCheckErr(RF, RoutineName)) return end subroutine + END MODULE SeaSt_WaveField_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 10dca7ab7d..48457786fe 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -53,7 +53,9 @@ MODULE SeaState PUBLIC :: SeaSt_JacobianPContState ! Jacobians dY/dx, dX/dx, dXd/dx, and dZ/dx PUBLIC :: SeaSt_JacobianPDiscState ! Jacobians dY/dxd, dX/dxd, dXd/dxd, and dZ/dxd PUBLIC :: SeaSt_JacobianPConstrState ! Jacobians dY/dz, dX/dz, dXd/dz, and dZ/dz - PUBLIC :: SeaSt_GetOP ! operating points u_op, y_op, x_op, dx_op, xd_op, and z_op + + PUBLIC :: SeaSt_PackExtInputAry ! Pack extended inputs + PUBLIC :: SeaSt_PackExtOutputAry ! Pack extended outputs CONTAINS !---------------------------------------------------------------------------------------------------------------------------------- @@ -334,13 +336,13 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init call SetErrStat( ErrID_Fatal, 'Constrained wave conditions cannot be used for linearization. Set ConstWaveMod=0.', ErrStat, ErrMsg, RoutineName ) end if - ! set the Jacobian info if we don't have a fatal error - if (ErrStat < AbortErrLev) then - call SeaSt_Init_Jacobian(p, InitOut, ErrStat2, ErrMsg2) - if (Failed()) return - endif end if + ! Initialize module variables if we don't have a fatal error + if (ErrStat < AbortErrLev) then + call SeaSt_InitVars(InitOut%Vars, u, p, x, y, m, InitOut, InputFileData, InitInp%Linearize, ErrStat2, ErrMsg2) + if (Failed()) return + endif ! Destroy the local initialization data CALL CleanUp() @@ -447,6 +449,81 @@ subroutine SurfaceVisGenerate(ErrStat3, ErrMsg3) end subroutine SurfaceVisGenerate END SUBROUTINE SeaSt_Init + +subroutine SeaSt_InitVars(Vars, u, p, x, y, m, InitOut, InputFileData, Linearize, ErrStat, ErrMsg) + type(ModVarsType), intent(out) :: Vars !< Module variables + type(SeaSt_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(SeaSt_ParameterType), intent(inout) :: p !< Parameters + type(SeaSt_ContinuousStateType), intent(inout) :: x !< Continuous state + type(SeaSt_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(SeaSt_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(SeaSt_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + type(SeaSt_InputFile), intent(in) :: InputFileData !< Input file data + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'SeaSt_InitVars' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + integer(IntKi) :: i, j, k + integer(IntKi), allocatable :: BladeMeshFields(:) + real(R8Ki) :: MaxThrust, MaxTorque, ScaleLength + integer(IntKi) :: Flags, Field + + ErrStat = ErrID_None + ErrMsg = "" + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + ! Extended input + call MV_AddVar(Vars%u, "WaveElev0", FieldScalar, DatLoc(SeaSt_u_WaveElev0), & + Flags=VF_ExtLin, & + Perturb=0.02_R8Ki * Pi / 180.0_R8Ki * max(1.0_R8Ki, real(p%WaveField%WtrDpth, R8Ki)), & + LinNames=['Extended input: wave elevation at platform ref point, m']) + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + ! Extended output + call MV_AddVar(Vars%y, "WaveElev0", FieldScalar, DatLoc(SeaSt_y_WaveElev0), & + Flags=VF_ExtLin, & + LinNames=['Extended output: wave elevation at platform ref point, m']) + + ! Output variables + call MV_AddVar(Vars%y, "WriteOutput", FieldScalar, DatLoc(SeaSt_y_WriteOutput), & + Num=p%NumOuts, & + Flags=VF_WriteOut, & + LinNames=[(WriteOutputLinName(i), i = 1, p%numOuts)]) + + !---------------------------------------------------------------------------- + ! Initialize Variables and Jacobian data + !---------------------------------------------------------------------------- + + call MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + call SeaSt_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SeaSt_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + +contains + function WriteOutputLinName(idx) result(name) + integer(IntKi), intent(in) :: idx + character(LinChanLen) :: name + name = trim(InitOut%WriteOutputHdr(idx))//', '//trim(InitOut%WriteOutputUnt(idx)) + end function + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine !---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE AddArrays_4D(Array1, Array2, ArrayName, ErrStat, ErrMsg) REAL(SiKi), INTENT(INOUT) :: Array1(:,:,:,:) @@ -661,19 +738,17 @@ SUBROUTINE SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er DO i = 1, p%NWaveKin positionXYZ = (/p%WaveKinxi(i),p%WaveKinyi(i),p%WaveKinzi(i)/) - CALL WaveField_GetNodeWaveKin( p%WaveField, m%WaveField_m, Time, positionXYZ, .FALSE., nodeInWater, zeta1, zeta2, zeta, WaveDynP(i), WaveVel(:,i), WaveAcc(:,i), WaveAccMCF(:,i), ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveKin( p%WaveField, m%WaveField_m, Time, positionXYZ, .FALSE., .TRUE., nodeInWater, zeta1, zeta2, zeta, WaveDynP(i), WaveVel(:,i), WaveAcc(:,i), WaveAccMCF(:,i), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO ! Compute the wave elevations at the requested output locations for this time. Note that p%WaveElev has the second order added to it already. DO i = 1, p%NWaveElev positionXY = (/p%WaveElevxi(i),p%WaveElevyi(i)/) - WaveElev1(i) = WaveField_GetNodeWaveElev1( p%WaveField, m%WaveField_m, Time, positionXY, ErrStat2, ErrMsg2 ) + zeta = WaveField_GetNodeTotalWaveElev(p%WaveField, m%WaveField_m, Time, positionXY, ErrStat2, ErrMsg2, Elev1=WaveElev1(i), Elev2=WaveElev2(i)) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveElev2(i) = WaveField_GetNodeWaveElev2( p%WaveField, m%WaveField_m, Time, positionXY, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveElev(i) = WaveElev1(i) + WaveElev2(i) END DO + WaveElev = WaveElev1 + WaveElev2 ! Map calculated results into the AllOuts Array CALL SeaStOut_MapOutputs( p, WaveElev, WaveElev1, WaveElev2, WaveVel, WaveAcc, WaveAccMCF, WaveDynP, AllOuts, ErrStat2, ErrMsg2 ) @@ -735,102 +810,11 @@ END SUBROUTINE SeaSt_CalcConstrStateResidual -!---------------------------------------------------------------------------------------------------------------------------------- -! Linearization routines -!---------------------------------------------------------------------------------------------------------------------------------- -!> Initialize Jacobian info for linearization (only u and y) -subroutine SeaSt_Init_Jacobian(p, InitOut, ErrStat, ErrMsg) - type(SeaSt_ParameterType), intent(inout) :: p !< Parameters - type(SeaSt_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - integer(IntKi) :: nu, ny ! counters for number of u and y linearization terms - integer(IntKi) :: i, idx ! generic indexing - integer(IntKi) :: ExtStart ! start of Extended input/output - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SeaSt_Init_Jacobian' - - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = '' - - !-------------------------- - ! Init Jacobians for u - !-------------------------- - - ! One extended input (WaveElev0), and no regular inputs. Starts at first index. - nu = 1 - p%LinParams%NumExtendedInputs = 1 - ! Total number of inputs (including regular and extended inputs) - p%LinParams%Jac_nu = nu - - ! Allocate storage for names, indexing, and perturbations - call AllocAry(InitOut%LinNames_u, nu, "LinNames_u", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(InitOut%RotFrame_u, nu, "RotFrame_u", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(InitOut%IsLoad_u, nu, "IsLoad_u", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(p%LinParams%du, nu, "LinParams%du", ErrStat2, ErrMsg2); if (Failed()) return - - ! Step through list of inputs and save names. No regular inputs, so we skip directly to the Extended input - ! WaveElev0 - extended input - ExtStart = 1 - InitOut%LinNames_u(ExtStart) = 'Extended input: wave elevation at platform ref point, m' - InitOut%RotFrame_u(ExtStart) = .false. - InitOut%IsLoad_u( ExtStart) = .false. - - p%LinParams%Jac_u_idxStartList%Extended = ExtStart - p%LinParams%du(ExtStart) = 0.02_ReKi * Pi / 180.0_ReKi * max(1.0_ReKi, p%WaveField%WtrDpth) ! TODO: check that this is the correct perturbation to use - - - !-------------------------- - ! Init Jacobians for y - !-------------------------- - - ! No regular outputs, only the extended outputs and the WrOuts - p%LinParams%NumExtendedOutputs = 1 - ExtStart = 1 ! Extended output is the first output - ny = 1 ! one extended output - p%LinParams%Jac_y_idxStartList%Extended = 1 - - ! Nunber of WrOuts (only if output to OpenFAST) - if ( p%OutSwtch /= 1 .and. allocated(InitOut%WriteOutputHdr) ) then - ny = ny + size(InitOut%WriteOutputHdr) - endif - - ! start position for WrOuts (may be beyond ny) - p%LinParams%Jac_y_idxStartList%WrOuts = p%LinParams%Jac_y_idxStartList%Extended + p%LinParams%NumExtendedOutputs - - ! Total number of outs (including regular outs and extended outs) - p%LinParams%Jac_ny = ny - - ! allocate some things - call AllocAry(InitOut%LinNames_y, ny, "LinNames_y", ErrStat2, ErrMsg2); if (Failed()) return; - call AllocAry(InitOut%RotFrame_y, ny, "RotFrame_y", ErrStat2, ErrMsg2); if (Failed()) return; - InitOut%RotFrame_y = .false. ! No outputs in rotating frame - - ! Set names: no regular output, so start at extended output - InitOut%LinNames_y(ExtStart) = 'Extended output: wave elevation at platform ref point, m' - - ! WrOuts names (only if output to OpenFAST) - if ( p%OutSwtch > 1 .and. allocated(InitOut%WriteOutputHdr) ) then - do i = 1,size(InitOut%WriteOutputHdr) - idx = p%LinParams%Jac_y_idxStartList%WrOuts - 1 + i ! current index - InitOut%LinNames_y(idx) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) - enddo - endif - - -contains - logical function Failed() - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - end function Failed -end subroutine SeaSt_Init_Jacobian !---------------------------------------------------------------------------------------------------------------------------------- !> Linearization Jacobians dY/du, dX/du, dXd/du, and dZ/du -subroutine SeaSt_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +subroutine SeaSt_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) + type(ModVarsType), intent(in ) :: Vars !< Module variables real(DbKi), intent(in ) :: t !< Time in seconds at operating point type(SeaSt_InputType), intent(inout) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) type(SeaSt_ParameterType), intent(in ) :: p !< Parameters @@ -847,54 +831,47 @@ subroutine SeaSt_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, E real(R8Ki), allocatable, optional, intent(inout) :: dXddu(:,:) !< Partial derivatives of discrete state real(R8Ki), allocatable, optional, intent(inout) :: dZdu(:,:) !< Partial derivatives of constraint state + character(*), parameter :: RoutineName = 'SeaSt_JacobianPInput' integer(IntKi) :: idx_dY,idx_du,i integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SeaSt_JacobianPInput' + integer(IntKi) :: iVar_u_WaveElev0, iVar_y_WaveElev0 ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' - if ( present( dYdu ) ) then - - ! If dYdu is allocated, make sure it is the correct size - if (allocated(dYdu)) then - if (size(dYdu,1) /= p%LinParams%Jac_ny .or. size(dYdu,2) /= p%LinParams%Jac_nu) deallocate (dYdu) + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) + if (present(dYdu)) then + + if (.not. allocated(dYdu)) then + call AllocAry(dYdu, m%Jac%Ny, m%Jac%Nu, 'dYdu', ErrStat2, ErrMsg2); if(Failed()) return endif - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: - ! - inputs are extended inputs only - ! - outputs are the extended outputs and the WriteOutput values - if (.not. ALLOCATED(dYdu)) then - call AllocAry( dYdu, p%LinParams%Jac_ny, p%LinParams%Jac_nu, 'dYdu', ErrStat2, ErrMsg2 ) - if (Failed()) return - end if - + ! Initialize Jacobian to zero dYdu = 0.0_R8Ki - ! Extended inputs to extended outputs (direct pass-through) - do i=1,min(p%LinParams%NumExtendedInputs,p%LinParams%NumExtendedOutputs) - idx_du = p%LinParams%Jac_u_idxStartList%Extended + i - 1 - idx_dY = p%LinParams%Jac_y_idxStartList%Extended + i - 1 - dYdu(idx_dY,idx_du) = 1.0_R8Ki - enddo + iVar_u_WaveElev0 = MV_FindVarDatLoc(Vars%u, DatLoc(SeaSt_u_WaveElev0)) + iVar_y_WaveElev0 = MV_FindVarDatLoc(Vars%y, DatLoc(SeaSt_y_WaveElev0)) + ! Extended input to extended output (direct pass-through) + if (iVar_u_WaveElev0 > 0 .and. iVar_y_WaveElev0 > 0) then + dYdu(Vars%y(iVar_y_WaveElev0)%iLoc(1), Vars%u(iVar_u_WaveElev0)%iLoc(1)) = 1.0_R8Ki + end if + ! It isn't possible to determine the relationship between the extended input and the WrOuts. So we leave them all zero. - endif - ! No states or constraints, so deallocate any such matrices - if ( present( dXdu ) ) then + if (present(dXdu)) then if (allocated(dXdu)) deallocate(dXdu) endif - if ( present( dXddu ) ) then + if (present(dXddu)) then if (allocated(dXddu)) deallocate(dXddu) endif - if ( present( dZdu ) ) then + if (present(dZdu)) then if (allocated(dZdu)) deallocate(dZdu) endif @@ -908,7 +885,8 @@ end subroutine SeaSt_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Linearization Jacobians dY/dx, dX/dx, dXd/dx, and dZ/dx !! No continuous states, so this doesn't do anything -subroutine SeaSt_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) +subroutine SeaSt_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx) + type(ModVarsType), intent(in ) :: Vars !< Module variables real(DbKi), intent(in ) :: t !< Time in seconds at operating point type(SeaSt_InputType), intent(in ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) type(SeaSt_ParameterType), intent(in ) :: p !< Parameters @@ -949,7 +927,8 @@ end subroutine SeaSt_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- !> Linearization Jacobians dY/dxd, dX/dxd, dXd/dxd, and dZ/dxd !! No discrete states, so this doesn't do anything -subroutine SeaSt_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) +subroutine SeaSt_JacobianPDiscState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd) + type(ModVarsType), intent(in ) :: Vars !< Module variables real(DbKi), intent(in ) :: t !< Time in seconds at operating point type(SeaSt_InputType), intent(in ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) type(SeaSt_ParameterType), intent(in ) :: p !< Parameters @@ -990,7 +969,8 @@ end subroutine SeaSt_JacobianPDiscState !---------------------------------------------------------------------------------------------------------------------------------- !> Linearization Jacobians dY/dz, dX/dz, dXd/dz, and dZ/dz !! No constraint states, so this doesn't do anything -subroutine SeaSt_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) +subroutine SeaSt_JacobianPConstrState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz) + type(ModVarsType), intent(in ) :: Vars !< Module variables real(DbKi), intent(in ) :: t !< Time in seconds at operating point type(SeaSt_InputType), intent(in ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) type(SeaSt_ParameterType), intent(in ) :: p !< Parameters @@ -1028,79 +1008,43 @@ subroutine SeaSt_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrS ! endif end subroutine SeaSt_JacobianPConstrState -!---------------------------------------------------------------------------------------------------------------------------------- -!> Linearization operating points u_op, y_op, x_op, dx_op, xd_op, and z_op -subroutine SeaSt_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) - real(DbKi), intent(in ) :: t !< Time in seconds at operating point - type(SeaSt_InputType), intent(in ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - type(SeaSt_ParameterType), intent(in ) :: p !< Parameters - type(SeaSt_ContinuousStateType), intent(in ) :: x !< Continuous states at operating point - type(SeaSt_DiscreteStateType), intent(in ) :: xd !< Discrete states at operating point - type(SeaSt_ConstraintStateType), intent(in ) :: z !< Constraint states at operating point - type(SeaSt_OtherStateType), intent(in ) :: OtherState !< Other states at operating point - type(SeaSt_OutputType), intent(in ) :: y !< Output at operating point - type(SeaSt_MiscVarType), intent(inout) :: m !< Misc/optimization variables - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - real(ReKi), allocatable, optional, intent(inout) :: u_op(:) !< values of linearized inputs - real(ReKi), allocatable, optional, intent(inout) :: y_op(:) !< values of linearized outputs - real(ReKi), allocatable, optional, intent(inout) :: x_op(:) !< values of linearized continuous states - real(ReKi), allocatable, optional, intent(inout) :: dx_op(:) !< values of first time derivatives of linearized continuous states - real(ReKi), allocatable, optional, intent(inout) :: xd_op(:) !< values of linearized discrete states - real(ReKi), allocatable, optional, intent(inout) :: z_op(:) !< values of linearized constraint states - - integer(IntKi) :: idxStart, idxEnd - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SeaSt_GetOP' - - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = '' - - - if ( present( u_op ) ) then - if (.not. allocated(u_op)) then - call AllocAry(u_op, p%LinParams%Jac_nu, 'u_op', ErrStat2, ErrMsg2) - if (Failed()) return - end if - - ! no regular inputs, only extended input - u_op(p%LinParams%Jac_u_idxStartList%Extended) = 0.0_ReKi ! WaveElev0 is zero to be consistent with linearization requirements - ! NOTE: if more extended inputs are added, place them here - end if - - if ( present( y_op ) ) then - if (.not. allocated(y_op)) then - call AllocAry(y_op, p%LinParams%Jac_ny, 'y_op', ErrStat2, ErrMsg2) - if (Failed()) return - end if - - ! no regular outputs, only extended output and WrOuts - y_op(p%LinParams%Jac_y_idxStartList%Extended) = 0.0_ReKi ! WaveElev0 is zero to be consistent with linearization requirements - ! NOTE: if more extended inputs are added, place them here - - ! WrOuts may not be sent to OpenFAST (y_op sized smaller if WrOuts not sent to OpenFAST) - if (p%LinParams%Jac_y_idxStartList%WrOuts <= p%LinParams%Jac_ny) then - idxStart = p%LinParams%Jac_y_idxStartList%WrOuts - idxEnd = p%LinParams%Jac_y_idxStartList%WrOuts + p%NumOuts - 1 - ! unnecessary array check to make me feel better about the potentially sloppy indexing - if (idxEnd > p%LinParams%Jac_ny) then - ErrStat2 = ErrID_Fatal; ErrMsg2 = "Error in the y_op sizing -- u_op not large enough for WrOuts" - if (Failed()) return - endif - ! copy over the returned outputs - y_op(idxStart:idxEnd) = y%WriteOutput(1:p%NumOuts) - endif - end if - - -contains - logical function Failed() - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - end function Failed -end subroutine SeaSt_GetOP +subroutine SeaSt_PackExtInputAry(Vars, u, ValAry) + type(ModVarsType), intent(in) :: Vars !< Module variables + type(SeaSt_InputType), intent(in) :: u !< Inputs + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + + ! Loop through Input variables + do i = 1, size(Vars%u) + associate (Var => Vars%u(i)) + ! Select based on data location number + select case (Var%DL%Num) + case (SeaSt_u_WaveElev0) + ! WaveElev0 is zero to be consistent with linearization requirements + ValAry(Vars%u(i)%iLoc(1):Vars%u(i)%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine + +subroutine SeaSt_PackExtOutputAry(Vars, y, ValAry) + type(ModVarsType), intent(in) :: Vars !< Module variables + type(SeaSt_OutputType), intent(in) :: y !< Outputs + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + + ! Loop through output variables + do i = 1, size(Vars%y) + associate (Var => Vars%y(i)) + ! Select based on data location number + select case (Var%DL%Num) + case (SeaSt_y_WaveElev0) + ! WaveElev0 is zero to be consistent with linearization requirements + ValAry(Vars%y(i)%iLoc(1):Vars%y(i)%iLoc(2)) = 0.0_R8Ki + end select + end associate + end do +end subroutine !---------------------------------------------------------------------------------------------------------------------------------- END MODULE SeaState diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index f38dfdf231..385d1fb24c 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -18,6 +18,9 @@ usefrom Current.txt usefrom Waves.txt usefrom Waves2.txt usefrom SeaSt_WaveField.txt + +param SeaState/SeaSt - IntKi SeaSt_u_WaveElev0 - -1 - "WaveElev0 Extended input DatLoc number" - +param ^ - IntKi SeaSt_y_WaveElev0 - -2 - "WaveElev0 Extended output DatLoc number" - # # typedef SeaState/SeaSt SeaSt_InputFile LOGICAL EchoFlag - - - "Echo the input file" @@ -71,6 +74,7 @@ typedef ^ ^ ReKi Gra typedef ^ ^ ReKi defWtrDens - - - "Default water density from the driver; may be overwritten " "(kg/m^3)" typedef ^ ^ ReKi defWtrDpth - - - "Default water depth from the driver; may be overwritten " "m" typedef ^ ^ ReKi defMSL2SWL - - - "Default mean sea level to still water level from the driver; may be overwritten" "m" +typedef ^ ^ IntKi MHK - - - "MHK flag" - typedef ^ ^ DbKi TMax - - - "Supplied by Driver: The total simulation time" "(sec)" typedef ^ ^ INTEGER WaveFieldMod - - - "Wave field handling (-) (switch) 0: use individual SeaState inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin" - typedef ^ ^ ReKi PtfmLocationX - - - "Supplied by Driver: X coordinate of platform location in the wave field" "m" @@ -78,6 +82,8 @@ typedef ^ ^ ReKi Ptf typedef ^ ^ IntKi WrWvKinMod - 0 - "0,1, or 2 indicating whether we are going to write out kinematics files. [ignored if WaveMod = 6, if 1 or 2 then files are written using the outrootname]" - typedef ^ ^ LOGICAL HasIce - - - "Supplied by Driver: Whether this simulation has ice loading (flag)" - typedef ^ ^ Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - +typedef ^ ^ LOGICAL hasCurrField - - - "Flag to indicate whether to expect current field from IfW" - +typedef ^ ^ IntKi CompSeaSt - - - "Flag to indicate whether SeaState module is activated" - typedef ^ ^ Logical SurfaceVis - .FALSE. - "Turn on grid surface visualization outputs" - typedef ^ ^ IntKi SurfaceVisNx - 0 - "Number of points in X direction to output for visualization grid. Use 0 or negative to set to SeaState resolution." - typedef ^ ^ IntKi SurfaceVisNy - 0 - "Number of points in Y direction to output for visualization grid. Use 0 or negative to set to SeaState resolution." - @@ -94,11 +100,7 @@ typedef ^ ^ SiKi Wav typedef ^ ^ SiKi WaveElevVisY {:} - - "Y locations of grid output" "m,-" typedef ^ ^ SiKi WaveElevVisGrid {:}{:}{:} - - "Wave elevation time-series at each of the points given by WaveElevXY. First dimension is the timestep. Second/third dimensions are the grid of points." (m) typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" -typedef ^ ^ CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - -typedef ^ ^ CHARACTER(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - -typedef ^ ^ LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - -typedef ^ ^ LOGICAL RotFrame_y {:} - - "Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame" - -typedef ^ ^ LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - +typedef ^ ^ ModVarsType Vars - - - "Module Variables" @@ -120,29 +122,6 @@ typedef ^ ConstraintStateType R8Ki # Define any other states, including integer or logical states here: typedef ^ OtherStateType R8Ki UnusedStates - - - "placeholder for states" - # -# ..... Misc/Optimization variables................................................................................................. -# Define any data that are used only for efficiency purposes (these variables are not associated with time): -# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. -typedef ^ MiscVarType INTEGER Decimate - - - "The output decimation counter" - -typedef ^ ^ DbKi LastOutTime - - - "Last time step which was written to the output file (sec)" - -typedef ^ ^ INTEGER LastIndWave - - - "The last index used in the wave kinematics arrays, used to optimize interpolation" - -typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - - -# .... Linearization params ....................................................................................................... -# NOTE: This is overkill given how limited linearization is. For completeness and similarity to other modules, keeping all this here. Also note some -# values are set here, but will be overwritten in the code. -typedef ^ Jac_u_idxStarts IntKi Extended - 1 - "Index to first point in u jacobian for Extended" - -typedef ^ Jac_y_idxStarts IntKi Extended - 1 - "Index to first point in y jacobian for Extended" - -typedef ^ Jac_y_idxStarts IntKi WrOuts - 2 - "Index to first point in y jacobian for WrOuts" - -typedef ^ SeaSt_LinParams IntKi NumExtendedInputs - 1 - "number of extended inputs" - -typedef ^ ^ IntKi NumExtendedOutputs - 1 - "number of extended outputs" - -typedef ^ ^ Jac_u_idxStarts Jac_u_idxStartList - - - "Starting indices for all Jac_u components" - -typedef ^ ^ Jac_y_idxStarts Jac_y_idxStartList - - - "Starting indices for all Jac_y components" - -typedef ^ ^ ReKi du {:} - - "vector that determines size of perturbation for u (inputs)" -typedef ^ ^ IntKi Jac_nu - - - "number of inputs in jacobian matrix" - -typedef ^ ^ IntKi Jac_ny - - - "number of outputs in jacobian matrix" - - - # ..... Parameters ................................................................................................................ # Define parameters here: @@ -168,7 +147,6 @@ typedef ^ ^ CHARACTER(1) Del typedef ^ ^ INTEGER UnOutFile - - - "File unit for the SeaState outputs" - typedef ^ ^ INTEGER OutDec - - - "Write every OutDec time steps" - typedef ^ ^ SeaSt_WaveFieldType &WaveField - - - "Wave field" - -typedef ^ ^ SeaSt_LinParams LinParams - - - "Linearization parameters" - # # @@ -181,3 +159,16 @@ typedef ^ InputType SiKi Dum # ..... Outputs ................................................................................................................... # Define outputs that are contained on the mesh here: typedef ^ OutputType ReKi WriteOutput {:} - - "Outputs to be written to the output file(s)" - + +# ..... Misc/Optimization variables................................................................................................. +# Define any data that are used only for efficiency purposes (these variables are not associated with time): +# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. +typedef ^ MiscVarType INTEGER Decimate - - - "The output decimation counter" - +typedef ^ ^ DbKi LastOutTime - - - "Last time step which was written to the output file (sec)" - +typedef ^ ^ INTEGER LastIndWave - - - "The last index used in the wave kinematics arrays, used to optimize interpolation" - +typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - + +# .... Linearization ....................................................................................................... +typedef ^ ^ ModJacType Jac - - - "Values corresponding to module variables" - +typedef ^ ^ SeaSt_InputType u_perturb - - - "Input type for linearization perturbation" - +typedef ^ ^ SeaSt_OutputType y_lin - - - "Output type for linearization perturbation" - diff --git a/modules/seastate/src/SeaState_DriverCode.f90 b/modules/seastate/src/SeaState_DriverCode.f90 index 885a1f50e7..da5b70719f 100644 --- a/modules/seastate/src/SeaState_DriverCode.f90 +++ b/modules/seastate/src/SeaState_DriverCode.f90 @@ -192,6 +192,7 @@ program SeaStateDriver ! Clean up and exit call SeaSt_DvrCleanup() end if + p%WaveField%hasCurrField = .FALSE. if ( Interval /= drvrInitInp%TimeInterval) then call SetErrStat( ErrID_Fatal, 'The SeaState Module attempted to change timestep interval, but this is not allowed. The SeaState Module must use the Driver Interval.', ErrStat, ErrMsg, 'Driver') diff --git a/modules/seastate/src/SeaState_Input.f90 b/modules/seastate/src/SeaState_Input.f90 index 0ddedbaffc..bea74858b2 100644 --- a/modules/seastate/src/SeaState_Input.f90 +++ b/modules/seastate/src/SeaState_Input.f90 @@ -888,6 +888,11 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! CurrMod - Current profile model switch + if ( InitInp%hasCurrField ) then + call SetErrStat( ErrID_Warn,'Expecting current field from InflowWind. Setting CurrMod to 0.',ErrStat,ErrMsg,RoutineName) + InputFileData%Current%CurrMod = 0 + end if + if ( ( InputFileData%Current%CurrMod /= 0 ) .AND. ( InputFileData%Current%CurrMod /= 1 ) .AND. ( InputFileData%Current%CurrMod /= 2 ) ) then call SetErrStat( ErrID_Fatal,'CurrMod must be 0, 1, or 2.',ErrStat,ErrMsg,RoutineName) @@ -899,6 +904,11 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er return end if + if ( ( InputFileData%Current%CurrMod /= 0 ) .AND. ( InitInp%MHK /= 0 ) ) then + call SetErrStat( ErrID_Fatal,'CurrMod must be set to 0 for an MHK turbine.',ErrStat,ErrMsg,RoutineName) + return + end if + ! CurrSSV0 - Sub-surface current velocity at still water level diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index bdd95ed4de..83366e77a8 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -37,6 +37,8 @@ MODULE SeaState_Types USE SeaSt_WaveField_Types USE NWTC_Library IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: SeaSt_u_WaveElev0 = -1 ! WaveElev0 Extended input DatLoc number [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SeaSt_y_WaveElev0 = -2 ! WaveElev0 Extended output DatLoc number [-] ! ========= SeaSt_InputFile ======= TYPE, PUBLIC :: SeaSt_InputFile LOGICAL :: EchoFlag = .false. !< Echo the input file [-] @@ -92,6 +94,7 @@ MODULE SeaState_Types REAL(ReKi) :: defWtrDens = 0.0_ReKi !< Default water density from the driver; may be overwritten [(kg/m^3)] REAL(ReKi) :: defWtrDpth = 0.0_ReKi !< Default water depth from the driver; may be overwritten [m] REAL(ReKi) :: defMSL2SWL = 0.0_ReKi !< Default mean sea level to still water level from the driver; may be overwritten [m] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK flag [-] REAL(DbKi) :: TMax = 0.0_R8Ki !< Supplied by Driver: The total simulation time [(sec)] INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) 0: use individual SeaState inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] REAL(ReKi) :: PtfmLocationX = 0.0_ReKi !< Supplied by Driver: X coordinate of platform location in the wave field [m] @@ -99,6 +102,8 @@ MODULE SeaState_Types INTEGER(IntKi) :: WrWvKinMod = 0 !< 0,1, or 2 indicating whether we are going to write out kinematics files. [ignored if WaveMod = 6, if 1 or 2 then files are written using the outrootname] [-] LOGICAL :: HasIce = .false. !< Supplied by Driver: Whether this simulation has ice loading (flag) [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] + LOGICAL :: hasCurrField = .false. !< Flag to indicate whether to expect current field from IfW [-] + INTEGER(IntKi) :: CompSeaSt = 0_IntKi !< Flag to indicate whether SeaState module is activated [-] LOGICAL :: SurfaceVis = .FALSE. !< Turn on grid surface visualization outputs [-] INTEGER(IntKi) :: SurfaceVisNx = 0 !< Number of points in X direction to output for visualization grid. Use 0 or negative to set to SeaState resolution. [-] INTEGER(IntKi) :: SurfaceVisNy = 0 !< Number of points in Y direction to output for visualization grid. Use 0 or negative to set to SeaState resolution. [-] @@ -114,11 +119,7 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevVisY !< Y locations of grid output [m,-] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevVisGrid !< Wave elevation time-series at each of the points given by WaveElevXY. First dimension is the timestep. Second/third dimensions are the grid of points. [(m)] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] - CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] - CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_y !< Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] + TYPE(ModVarsType) :: Vars !< Module Variables [-] END TYPE SeaSt_InitOutputType ! ======================= ! ========= SeaSt_ContinuousStateType ======= @@ -141,36 +142,6 @@ MODULE SeaState_Types REAL(R8Ki) :: UnusedStates = 0.0_R8Ki !< placeholder for states [-] END TYPE SeaSt_OtherStateType ! ======================= -! ========= SeaSt_MiscVarType ======= - TYPE, PUBLIC :: SeaSt_MiscVarType - INTEGER(IntKi) :: Decimate = 0_IntKi !< The output decimation counter [-] - REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Last time step which was written to the output file (sec) [-] - INTEGER(IntKi) :: LastIndWave = 0_IntKi !< The last index used in the wave kinematics arrays, used to optimize interpolation [-] - TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] - END TYPE SeaSt_MiscVarType -! ======================= -! ========= Jac_u_idxStarts ======= - TYPE, PUBLIC :: Jac_u_idxStarts - INTEGER(IntKi) :: Extended = 1 !< Index to first point in u jacobian for Extended [-] - END TYPE Jac_u_idxStarts -! ======================= -! ========= Jac_y_idxStarts ======= - TYPE, PUBLIC :: Jac_y_idxStarts - INTEGER(IntKi) :: Extended = 1 !< Index to first point in y jacobian for Extended [-] - INTEGER(IntKi) :: WrOuts = 2 !< Index to first point in y jacobian for WrOuts [-] - END TYPE Jac_y_idxStarts -! ======================= -! ========= SeaSt_LinParams ======= - TYPE, PUBLIC :: SeaSt_LinParams - INTEGER(IntKi) :: NumExtendedInputs = 1 !< number of extended inputs [-] - INTEGER(IntKi) :: NumExtendedOutputs = 1 !< number of extended outputs [-] - TYPE(Jac_u_idxStarts) :: Jac_u_idxStartList !< Starting indices for all Jac_u components [-] - TYPE(Jac_y_idxStarts) :: Jac_y_idxStartList !< Starting indices for all Jac_y components [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] - INTEGER(IntKi) :: Jac_nu = 0_IntKi !< number of inputs in jacobian matrix [-] - INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] - END TYPE SeaSt_LinParams -! ======================= ! ========= SeaSt_ParameterType ======= TYPE, PUBLIC :: SeaSt_ParameterType REAL(DbKi) :: WaveDT = 0.0_R8Ki !< Wave DT [sec] @@ -193,7 +164,6 @@ MODULE SeaState_Types INTEGER(IntKi) :: UnOutFile = 0_IntKi !< File unit for the SeaState outputs [-] INTEGER(IntKi) :: OutDec = 0_IntKi !< Write every OutDec time steps [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Wave field [-] - TYPE(SeaSt_LinParams) :: LinParams !< Linearization parameters [-] END TYPE SeaSt_ParameterType ! ======================= ! ========= SeaSt_InputType ======= @@ -206,7 +176,23 @@ MODULE SeaState_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Outputs to be written to the output file(s) [-] END TYPE SeaSt_OutputType ! ======================= -CONTAINS +! ========= SeaSt_MiscVarType ======= + TYPE, PUBLIC :: SeaSt_MiscVarType + INTEGER(IntKi) :: Decimate = 0_IntKi !< The output decimation counter [-] + REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Last time step which was written to the output file (sec) [-] + INTEGER(IntKi) :: LastIndWave = 0_IntKi !< The last index used in the wave kinematics arrays, used to optimize interpolation [-] + TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] + TYPE(ModJacType) :: Jac !< Values corresponding to module variables [-] + TYPE(SeaSt_InputType) :: u_perturb !< Input type for linearization perturbation [-] + TYPE(SeaSt_OutputType) :: y_lin !< Output type for linearization perturbation [-] + END TYPE SeaSt_MiscVarType +! ======================= + integer(IntKi), public, parameter :: SeaSt_x_UnusedStates = 1 ! SeaSt%UnusedStates + integer(IntKi), public, parameter :: SeaSt_z_UnusedStates = 2 ! SeaSt%UnusedStates + integer(IntKi), public, parameter :: SeaSt_u_DummyInput = 3 ! SeaSt%DummyInput + integer(IntKi), public, parameter :: SeaSt_y_WriteOutput = 4 ! SeaSt%WriteOutput + +contains subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) type(SeaSt_InputFile), intent(in) :: SrcInputFileData @@ -491,6 +477,7 @@ subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%defWtrDens = SrcInitInputData%defWtrDens DstInitInputData%defWtrDpth = SrcInitInputData%defWtrDpth DstInitInputData%defMSL2SWL = SrcInitInputData%defMSL2SWL + DstInitInputData%MHK = SrcInitInputData%MHK DstInitInputData%TMax = SrcInitInputData%TMax DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX @@ -498,6 +485,8 @@ subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WrWvKinMod = SrcInitInputData%WrWvKinMod DstInitInputData%HasIce = SrcInitInputData%HasIce DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%hasCurrField = SrcInitInputData%hasCurrField + DstInitInputData%CompSeaSt = SrcInitInputData%CompSeaSt DstInitInputData%SurfaceVis = SrcInitInputData%SurfaceVis DstInitInputData%SurfaceVisNx = SrcInitInputData%SurfaceVisNx DstInitInputData%SurfaceVisNy = SrcInitInputData%SurfaceVisNy @@ -529,6 +518,7 @@ subroutine SeaSt_PackInitInput(RF, Indata) call RegPack(RF, InData%defWtrDens) call RegPack(RF, InData%defWtrDpth) call RegPack(RF, InData%defMSL2SWL) + call RegPack(RF, InData%MHK) call RegPack(RF, InData%TMax) call RegPack(RF, InData%WaveFieldMod) call RegPack(RF, InData%PtfmLocationX) @@ -536,6 +526,8 @@ subroutine SeaSt_PackInitInput(RF, Indata) call RegPack(RF, InData%WrWvKinMod) call RegPack(RF, InData%HasIce) call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%hasCurrField) + call RegPack(RF, InData%CompSeaSt) call RegPack(RF, InData%SurfaceVis) call RegPack(RF, InData%SurfaceVisNx) call RegPack(RF, InData%SurfaceVisNy) @@ -555,6 +547,7 @@ subroutine SeaSt_UnPackInitInput(RF, OutData) call RegUnpack(RF, OutData%defWtrDens); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%defWtrDpth); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%defMSL2SWL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%TMax); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%WaveFieldMod); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%PtfmLocationX); if (RegCheckErr(RF, RoutineName)) return @@ -562,6 +555,8 @@ subroutine SeaSt_UnPackInitInput(RF, OutData) call RegUnpack(RF, OutData%WrWvKinMod); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%HasIce); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%hasCurrField); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompSeaSt); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SurfaceVis); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SurfaceVisNx); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SurfaceVisNy); if (RegCheckErr(RF, RoutineName)) return @@ -644,66 +639,9 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveElevVisGrid = SrcInitOutputData%WaveElevVisGrid end if DstInitOutputData%WaveField => SrcInitOutputData%WaveField - if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y) - if (.not. allocated(DstInitOutputData%LinNames_y)) then - allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y - end if - if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u) - if (.not. allocated(DstInitOutputData%LinNames_u)) then - allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u - end if - if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) - if (.not. allocated(DstInitOutputData%RotFrame_u)) then - allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u - end if - if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) - if (.not. allocated(DstInitOutputData%RotFrame_y)) then - allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y - end if - if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) - if (.not. allocated(DstInitOutputData%IsLoad_u)) then - allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u - end if + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -733,21 +671,8 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) deallocate(InitOutputData%WaveElevVisGrid) end if nullify(InitOutputData%WaveField) - if (allocated(InitOutputData%LinNames_y)) then - deallocate(InitOutputData%LinNames_y) - end if - if (allocated(InitOutputData%LinNames_u)) then - deallocate(InitOutputData%LinNames_u) - end if - if (allocated(InitOutputData%RotFrame_u)) then - deallocate(InitOutputData%RotFrame_u) - end if - if (allocated(InitOutputData%RotFrame_y)) then - deallocate(InitOutputData%RotFrame_y) - end if - if (allocated(InitOutputData%IsLoad_u)) then - deallocate(InitOutputData%IsLoad_u) - end if + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine SeaSt_PackInitOutput(RF, Indata) @@ -770,11 +695,7 @@ subroutine SeaSt_PackInitOutput(RF, Indata) call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) end if end if - call RegPackAlloc(RF, InData%LinNames_y) - call RegPackAlloc(RF, InData%LinNames_u) - call RegPackAlloc(RF, InData%RotFrame_u) - call RegPackAlloc(RF, InData%RotFrame_y) - call RegPackAlloc(RF, InData%IsLoad_u) + call NWTC_Library_PackModVarsType(RF, InData%Vars) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -813,11 +734,7 @@ subroutine SeaSt_UnPackInitOutput(RF, OutData) else OutData%WaveField => null() end if - call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end subroutine subroutine SeaSt_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -972,226 +889,6 @@ subroutine SeaSt_UnPackOtherState(RF, OutData) call RegUnpack(RF, OutData%UnusedStates); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SeaSt_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(SeaSt_MiscVarType), intent(in) :: SrcMiscData - type(SeaSt_MiscVarType), intent(inout) :: DstMiscData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SeaSt_CopyMisc' - ErrStat = ErrID_None - ErrMsg = '' - DstMiscData%Decimate = SrcMiscData%Decimate - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - DstMiscData%LastIndWave = SrcMiscData%LastIndWave - call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return -end subroutine - -subroutine SeaSt_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(SeaSt_MiscVarType), intent(inout) :: MiscData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SeaSt_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = '' - call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -end subroutine - -subroutine SeaSt_PackMisc(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SeaSt_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SeaSt_PackMisc' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%Decimate) - call RegPack(RF, InData%LastOutTime) - call RegPack(RF, InData%LastIndWave) - call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_UnPackMisc(RF, OutData) - type(RegFile), intent(inout) :: RF - type(SeaSt_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SeaSt_UnPackMisc' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%Decimate); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LastIndWave); if (RegCheckErr(RF, RoutineName)) return - call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m -end subroutine - -subroutine SeaSt_CopyJac_u_idxStarts(SrcJac_u_idxStartsData, DstJac_u_idxStartsData, CtrlCode, ErrStat, ErrMsg) - type(Jac_u_idxStarts), intent(in) :: SrcJac_u_idxStartsData - type(Jac_u_idxStarts), intent(inout) :: DstJac_u_idxStartsData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_CopyJac_u_idxStarts' - ErrStat = ErrID_None - ErrMsg = '' - DstJac_u_idxStartsData%Extended = SrcJac_u_idxStartsData%Extended -end subroutine - -subroutine SeaSt_DestroyJac_u_idxStarts(Jac_u_idxStartsData, ErrStat, ErrMsg) - type(Jac_u_idxStarts), intent(inout) :: Jac_u_idxStartsData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_DestroyJac_u_idxStarts' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine SeaSt_PackJac_u_idxStarts(RF, Indata) - type(RegFile), intent(inout) :: RF - type(Jac_u_idxStarts), intent(in) :: InData - character(*), parameter :: RoutineName = 'SeaSt_PackJac_u_idxStarts' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%Extended) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_UnPackJac_u_idxStarts(RF, OutData) - type(RegFile), intent(inout) :: RF - type(Jac_u_idxStarts), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SeaSt_UnPackJac_u_idxStarts' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%Extended); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_CopyJac_y_idxStarts(SrcJac_y_idxStartsData, DstJac_y_idxStartsData, CtrlCode, ErrStat, ErrMsg) - type(Jac_y_idxStarts), intent(in) :: SrcJac_y_idxStartsData - type(Jac_y_idxStarts), intent(inout) :: DstJac_y_idxStartsData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_CopyJac_y_idxStarts' - ErrStat = ErrID_None - ErrMsg = '' - DstJac_y_idxStartsData%Extended = SrcJac_y_idxStartsData%Extended - DstJac_y_idxStartsData%WrOuts = SrcJac_y_idxStartsData%WrOuts -end subroutine - -subroutine SeaSt_DestroyJac_y_idxStarts(Jac_y_idxStartsData, ErrStat, ErrMsg) - type(Jac_y_idxStarts), intent(inout) :: Jac_y_idxStartsData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_DestroyJac_y_idxStarts' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine SeaSt_PackJac_y_idxStarts(RF, Indata) - type(RegFile), intent(inout) :: RF - type(Jac_y_idxStarts), intent(in) :: InData - character(*), parameter :: RoutineName = 'SeaSt_PackJac_y_idxStarts' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%Extended) - call RegPack(RF, InData%WrOuts) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_UnPackJac_y_idxStarts(RF, OutData) - type(RegFile), intent(inout) :: RF - type(Jac_y_idxStarts), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SeaSt_UnPackJac_y_idxStarts' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%Extended); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%WrOuts); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_CopyLinParams(SrcLinParamsData, DstLinParamsData, CtrlCode, ErrStat, ErrMsg) - type(SeaSt_LinParams), intent(in) :: SrcLinParamsData - type(SeaSt_LinParams), intent(inout) :: DstLinParamsData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SeaSt_CopyLinParams' - ErrStat = ErrID_None - ErrMsg = '' - DstLinParamsData%NumExtendedInputs = SrcLinParamsData%NumExtendedInputs - DstLinParamsData%NumExtendedOutputs = SrcLinParamsData%NumExtendedOutputs - call SeaSt_CopyJac_u_idxStarts(SrcLinParamsData%Jac_u_idxStartList, DstLinParamsData%Jac_u_idxStartList, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call SeaSt_CopyJac_y_idxStarts(SrcLinParamsData%Jac_y_idxStartList, DstLinParamsData%Jac_y_idxStartList, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcLinParamsData%du)) then - LB(1:1) = lbound(SrcLinParamsData%du) - UB(1:1) = ubound(SrcLinParamsData%du) - if (.not. allocated(DstLinParamsData%du)) then - allocate(DstLinParamsData%du(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinParamsData%du.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinParamsData%du = SrcLinParamsData%du - end if - DstLinParamsData%Jac_nu = SrcLinParamsData%Jac_nu - DstLinParamsData%Jac_ny = SrcLinParamsData%Jac_ny -end subroutine - -subroutine SeaSt_DestroyLinParams(LinParamsData, ErrStat, ErrMsg) - type(SeaSt_LinParams), intent(inout) :: LinParamsData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SeaSt_DestroyLinParams' - ErrStat = ErrID_None - ErrMsg = '' - call SeaSt_DestroyJac_u_idxStarts(LinParamsData%Jac_u_idxStartList, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_DestroyJac_y_idxStarts(LinParamsData%Jac_y_idxStartList, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(LinParamsData%du)) then - deallocate(LinParamsData%du) - end if -end subroutine - -subroutine SeaSt_PackLinParams(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SeaSt_LinParams), intent(in) :: InData - character(*), parameter :: RoutineName = 'SeaSt_PackLinParams' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%NumExtendedInputs) - call RegPack(RF, InData%NumExtendedOutputs) - call SeaSt_PackJac_u_idxStarts(RF, InData%Jac_u_idxStartList) - call SeaSt_PackJac_y_idxStarts(RF, InData%Jac_y_idxStartList) - call RegPackAlloc(RF, InData%du) - call RegPack(RF, InData%Jac_nu) - call RegPack(RF, InData%Jac_ny) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_UnPackLinParams(RF, OutData) - type(RegFile), intent(inout) :: RF - type(SeaSt_LinParams), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SeaSt_UnPackLinParams' - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%NumExtendedInputs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumExtendedOutputs); if (RegCheckErr(RF, RoutineName)) return - call SeaSt_UnpackJac_u_idxStarts(RF, OutData%Jac_u_idxStartList) ! Jac_u_idxStartList - call SeaSt_UnpackJac_y_idxStarts(RF, OutData%Jac_y_idxStartList) ! Jac_y_idxStartList - call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_nu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return -end subroutine - subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) type(SeaSt_ParameterType), intent(in) :: SrcParamData type(SeaSt_ParameterType), intent(inout) :: DstParamData @@ -1306,9 +1003,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end if - call SeaSt_CopyLinParams(SrcParamData%LinParams, DstParamData%LinParams, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end subroutine subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) @@ -1352,8 +1046,6 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%WaveField) ParamData%WaveField => null() end if - call SeaSt_DestroyLinParams(ParamData%LinParams, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine SeaSt_PackParam(RF, Indata) @@ -1398,7 +1090,6 @@ subroutine SeaSt_PackParam(RF, Indata) call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) end if end if - call SeaSt_PackLinParams(RF, InData%LinParams) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1462,7 +1153,6 @@ subroutine SeaSt_UnPackParam(RF, OutData) else OutData%WaveField => null() end if - call SeaSt_UnpackLinParams(RF, OutData%LinParams) ! LinParams end subroutine subroutine SeaSt_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -1559,5 +1249,353 @@ subroutine SeaSt_UnPackOutput(RF, OutData) if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine + +subroutine SeaSt_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_MiscVarType), intent(in) :: SrcMiscData + type(SeaSt_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%Decimate = SrcMiscData%Decimate + DstMiscData%LastOutTime = SrcMiscData%LastOutTime + DstMiscData%LastIndWave = SrcMiscData%LastIndWave + call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine SeaSt_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SeaSt_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SeaSt_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Decimate) + call RegPack(RF, InData%LastOutTime) + call RegPack(RF, InData%LastIndWave) + call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) + call NWTC_Library_PackModJacType(RF, InData%Jac) + call SeaSt_PackInput(RF, InData%u_perturb) + call SeaSt_PackOutput(RF, InData%y_lin) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackMisc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Decimate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastIndWave); if (RegCheckErr(RF, RoutineName)) return + call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call SeaSt_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call SeaSt_UnpackOutput(RF, OutData%y_lin) ! y_lin +end subroutine + +function SeaSt_InputMeshPointer(u, DL) result(Mesh) + type(SeaSt_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +function SeaSt_OutputMeshPointer(y, DL) result(Mesh) + type(SeaSt_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +subroutine SeaSt_VarsPackContState(Vars, x, ValAry) + type(SeaSt_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SeaSt_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine SeaSt_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SeaSt_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SeaSt_x_UnusedStates) + VarVals(1) = x%UnusedStates ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SeaSt_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SeaSt_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SeaSt_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine SeaSt_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SeaSt_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SeaSt_x_UnusedStates) + x%UnusedStates = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function SeaSt_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SeaSt_x_UnusedStates) + Name = "x%UnusedStates" + case default + Name = "Unknown Field" + end select +end function + +subroutine SeaSt_VarsPackContStateDeriv(Vars, x, ValAry) + type(SeaSt_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SeaSt_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine SeaSt_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SeaSt_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SeaSt_x_UnusedStates) + VarVals(1) = x%UnusedStates ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SeaSt_VarsPackConstrState(Vars, z, ValAry) + type(SeaSt_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call SeaSt_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine SeaSt_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(SeaSt_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SeaSt_z_UnusedStates) + VarVals(1) = z%UnusedStates ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SeaSt_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SeaSt_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call SeaSt_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine SeaSt_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SeaSt_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SeaSt_z_UnusedStates) + z%UnusedStates = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function SeaSt_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SeaSt_z_UnusedStates) + Name = "z%UnusedStates" + case default + Name = "Unknown Field" + end select +end function + +subroutine SeaSt_VarsPackInput(Vars, u, ValAry) + type(SeaSt_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call SeaSt_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine SeaSt_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(SeaSt_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SeaSt_u_DummyInput) + VarVals(1) = u%DummyInput ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SeaSt_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SeaSt_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call SeaSt_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine SeaSt_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SeaSt_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SeaSt_u_DummyInput) + u%DummyInput = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function SeaSt_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SeaSt_u_DummyInput) + Name = "u%DummyInput" + case default + Name = "Unknown Field" + end select +end function + +subroutine SeaSt_VarsPackOutput(Vars, y, ValAry) + type(SeaSt_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call SeaSt_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine SeaSt_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(SeaSt_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SeaSt_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SeaSt_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SeaSt_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call SeaSt_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine SeaSt_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SeaSt_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SeaSt_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function SeaSt_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SeaSt_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE SeaState_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index 02a2606df1..34e1bb24f2 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -56,7 +56,8 @@ MODULE Waves2_Types REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveVel2S !< Instantaneous 2nd-order sum frequency correction for the velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] END TYPE Waves2_InitOutputType ! ======================= -CONTAINS + +contains subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(Waves2_InitInputType), intent(in) :: SrcInitInputData @@ -308,5 +309,7 @@ subroutine Waves2_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WaveVel2D); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WaveVel2S); if (RegCheckErr(RF, RoutineName)) return end subroutine + END MODULE Waves2_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index 0c3e3c9f99..fce0e83f2e 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -76,7 +76,8 @@ MODULE Waves_Types REAL(DbKi) :: WaveTMax = 0.0_R8Ki !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] END TYPE Waves_InitOutputType ! ======================= -CONTAINS + +contains subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(Waves_InitInputType), intent(in) :: SrcInitInputData @@ -334,5 +335,7 @@ subroutine Waves_UnPackInitOutput(RF, OutData) call RegUnpack(RF, OutData%WaveNDir); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%WaveTMax); if (RegCheckErr(RF, RoutineName)) return end subroutine + END MODULE Waves_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index 6866cd3241..cd62a354c4 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -588,6 +588,11 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO InitOut%CouplingScheme = ExplicitLoose END IF + !............................................................................................ + ! Initialize module variables + !............................................................................................ + call SrvD_InitVars( InitInp, u, p, x, y, m, InitOut, InitInp%Linearize, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !............................................................................................ ! Close summary file: @@ -618,6 +623,247 @@ subroutine Cleanup() ! Ignore any errors here end subroutine Cleanup END SUBROUTINE SrvD_Init +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes module variables for use by the solver and linearization. +subroutine SrvD_InitVars(InitInp, u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(SrvD_InitInputType), intent(in) :: InitInp !< Initialization input + type(SrvD_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(SrvD_ParameterType), intent(inout) :: p !< Parameters + type(SrvD_ContinuousStateType), intent(inout) :: x !< Continuous state + type(SrvD_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(SrvD_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(SrvD_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'SrvD_InitVars' + integer(IntKi) :: ErrStat2 ! Temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + character(ChanLen) :: Desc + integer(IntKi) :: i, j, k + character(36), parameter :: StCLabels(*) = [& + ' local displacement state X m ', & + ' local displacement state dX/dt m/s', & + ' local displacement state Y m ', & + ' local displacement state dY/dt m/s', & + ' local displacement state Z m ', & + ' local displacement state dZ/dt m/s'] + integer(IntKi), parameter :: StCInds(*) = [1, 3, 5, 2, 4, 6] + real(R8Ki) :: xPerturb, uPerturbTrans, uPerturbAng, uPerturbs(6) + + ErrStat = ErrID_None + ErrMsg = "" + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Add pointers to vars to initialization output + InitOut%Vars => p%Vars + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + ! Calculate perturbations + xPerturb = 0.2_R8Ki*Pi/180.0_R8Ki * max(real(TwoNorm(InitInp%NacRefPos - InitInp%TwrBaseRefPos), R8Ki), 1.0_R8Ki) + + ! Blade Structural Controller + do j = 1, p%NumBStC + do i = 1, p%NumBl + Desc = 'Blade '//trim(Num2LStr(i))//' StC '//Num2LStr(j) + do k = 1, size(StCInds) + call MV_AddVar(p%Vars%x, Desc, FieldScalar, DatLoc(SrvD_x_BStC_StC_x, j), & + iAry=StCInds(k), jAry=i, & + Flags=VF_DerivOrder2+VF_RotFrame, & + LinNames=[trim(Desc)//StCLabels(StCInds(k))], & + Perturb=xPerturb) + end do + end do + end do + + ! Nacelle Structural Controller + do j = 1, p%NumNStC + Desc = 'Nacelle StC '//Num2LStr(j) + do k = 1, size(StCInds) + call MV_AddVar(p%Vars%x, Desc, FieldScalar, DatLoc(SrvD_x_NStC_StC_x, j), & + iAry=StCInds(k), jAry=1, & + Flags=VF_DerivOrder2, & + LinNames=[trim(Desc)//StCLabels(StCInds(k))], & + Perturb=xPerturb) + end do + enddo + + ! Tower Structural Controller + do j = 1, p%NumTStC + Desc = 'Tower StC '//Num2LStr(j) + do k = 1, size(StCInds) + call MV_AddVar(p%Vars%x, Desc, FieldScalar, DatLoc(SrvD_x_TStC_StC_x, j), & + iAry=StCInds(k), jAry=1, & + Flags=VF_DerivOrder2, & + LinNames=[trim(Desc)//StCLabels(StCInds(k))], & + Perturb=xPerturb) + end do + enddo + + ! Substructure Structural Controller + do j = 1, p%NumSStC + Desc = 'Substructure StC '//Num2LStr(j) + do k = 1, size(StCInds) + call MV_AddVar(p%Vars%x, Desc, FieldScalar, DatLoc(SrvD_x_SStC_StC_x, j), & + iAry=StCInds(k), jAry=1, & + Flags=VF_DerivOrder2, & + LinNames=[trim(Desc)//StCLabels(StCInds(k))], & + Perturb=xPerturb) + end do + enddo + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + uPerturbTrans = 0.2_R8Ki*Pi_R8/180.0_R8Ki * max(real(TwoNorm(InitInp%NacRefPos - InitInp%TwrBaseRefPos),R8Ki), 1.0_R8Ki) + uPerturbAng = 0.2_R8Ki * Pi_R8 / 180.0_R8Ki + uPerturbs = [uPerturbTrans, uPerturbAng, uPerturbTrans, uPerturbAng, uPerturbTrans, uPerturbAng] + + call MV_AddVar(p%Vars%u, "Yaw", FieldScalar, DatLoc(SrvD_u_Yaw), Flags=VF_2PI, LinNames=['Yaw, rad']) + + call MV_AddVar(p%Vars%u, "YawRate", FieldScalar, DatLoc(SrvD_u_YawRate), LinNames=['YawRate, rad/s']) + + call MV_AddVar(p%Vars%u, "HSS_Spd", FieldScalar, DatLoc(SrvD_u_HSS_Spd), LinNames=['HSS_Spd, rad/s']) + + ! Structural controllers + do j = 1, p%NumBStC + do i = 1, p%NumBl + call MV_AddMeshVar(p%Vars%u, 'Blade '//trim(Num2LStr(i))//' StC '//Num2LStr(j), MotionFields, & + DatLoc(SrvD_u_BStCMotionMesh, i, j), & + Mesh=u%BStCMotionMesh(i, j), & + Perturbs=uPerturbs) + end do + end do + + do j = 1, p%NumNStC + call MV_AddMeshVar(p%Vars%u, 'Nacelle StC '//Num2LStr(j), MotionFields, & + DatLoc(SrvD_u_NStCMotionMesh, j), & + Mesh=u%NStCMotionMesh(j), & + Perturbs=uPerturbs) + enddo + + do j = 1, p%NumTStC + call MV_AddMeshVar(p%Vars%u, 'Tower StC '//Num2LStr(j), MotionFields, & + DatLoc(SrvD_u_TStCMotionMesh, j), & + Mesh=u%TStCMotionMesh(j), & + Perturbs=uPerturbs) + enddo + + do j = 1, p%NumSStC + call MV_AddMeshVar(p%Vars%u, 'Substructure StC '//Num2LStr(j), MotionFields, & + DatLoc(SrvD_u_SStCMotionMesh, j), & + Mesh=u%SStCMotionMesh(j), & + Perturbs=uPerturbs) + enddo + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + call MV_AddVar(p%Vars%y, "BlPitchCom", FieldScalar, & + DatLoc(SrvD_y_BlPitchCom), & + Flags=VF_RotFrame + VF_2PI, & + Num=size(y%BlPitchCom), & + LinNames=[('BlPitchCom('//trim(Num2LStr(i))//'), rad', i = 1, size(y%BlPitchCom))]) + + call MV_AddVar(p%Vars%y, "YawMom", FieldScalar, & + DatLoc(SrvD_y_YawMom), & + LinNames=['YawMom, Nm']) + + call MV_AddVar(p%Vars%y, "GenTrq", FieldScalar, & + DatLoc(SrvD_y_GenTrq), & + LinNames=['GenTrq, Nm']) + + call MV_AddVar(p%Vars%y, "ElecPwr", FieldScalar, & + DatLoc(SrvD_y_ElecPwr), & + LinNames=['ElecPwr, W']) + + ! Structural controllers + if (p%NumBStC > 0) then + do j = 1, p%NumBStC + do i = 1, p%NumBl + call MV_AddMeshVar(p%Vars%y, 'Blade '//trim(Num2LStr(i))//' StC '//Num2LStr(j), LoadFields, & + DatLoc(SrvD_y_BStCLoadMesh, i, j), & + Mesh=y%BStCLoadMesh(i,j)) + end do + end do + end if + + if (p%NumNStC > 0) then + do j = 1, p%NumNStC + call MV_AddMeshVar(p%Vars%y, 'Nacelle StC '//Num2LStr(j), LoadFields, & + DatLoc(SrvD_y_NStCLoadMesh, j), & + Mesh=y%NStCLoadMesh(j)) + enddo + end if + + if (p%NumTStC > 0) then + do j = 1, p%NumTStC + call MV_AddMeshVar(p%Vars%y, 'Tower StC '//Num2LStr(j), LoadFields, & + DatLoc(SrvD_y_TStCLoadMesh, j), & + Mesh=y%TStCLoadMesh(j)) + enddo + end if + + if (p%NumSStC > 0) then + do j = 1, p%NumSStC + call MV_AddMeshVar(p%Vars%y, 'Substructure StC '//Num2LStr(j), LoadFields, & + DatLoc(SrvD_y_SStCLoadMesh, j), & + Mesh=y%SStCLoadMesh(j)) + enddo + end if + + ! Write Outputs + do i = 1, p%NumOuts + call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, FieldScalar, & + DatLoc(SrvD_y_WriteOutput), iAry=i, & + Flags=VF_WriteOut + OutParamFlags(p%OutParam(i)%Indx), & + LinNames=[trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units], & + Active=(p%OutParam(i)%Indx > 0)) + end do + + !---------------------------------------------------------------------------- + ! Initialize Variables and Jacobian data + !---------------------------------------------------------------------------- + + CALL MV_InitVarsJac(p%Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + call SrvD_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SrvD_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SrvD_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SrvD_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + +contains + function OutParamFlags(indx) result(flagsRes) + integer(IntKi), intent(in) :: indx + integer(IntKi) :: flagsRes + integer(IntKi), parameter :: RotatingFrameIndices(*) = [& + BlPitchC, BStC_XQ, BStC_XQD, BStC_YQ, BStC_YQD, BStC_ZQ, BStC_ZQD, & + BStC_Fxl, BStC_Fyl, BStC_Fzl, BStC_Mxl, BStC_Myl, BStC_Mzl] + if (any(indx == RotatingFrameIndices)) then + flagsRes = VF_RotFrame + else + flagsRes = VF_None + end if + end function + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- !> Initialize everything needed for linearization subroutine SrvD_Init_Jacobian( InitInp, p, u, y, InitOut, ErrStat, ErrMsg ) @@ -4254,12 +4500,12 @@ SUBROUTINE SrvD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_o 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 - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states INTEGER(IntKi) :: ErrStat2 ! Error status of the operation (occurs after initial error) CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None @@ -4303,190 +4549,194 @@ end function Failed !> Get the operating point inputs and pack subroutine Get_u_op() - integer(IntKi) :: nu,i,j,index_next - - if (.not. allocated(u_op)) then - ! our operating point includes DCM (orientation) matrices, not just small angles like the perturbation matrices do - nu = p%Jac_nu & - + p%NumBStC * 6 * p%NumBl & ! Jac_nu has 3 for Orientation, but we need 9 at each BStC instance on each blade - + p%NumNStC * 6 & ! Jac_nu has 3 for Orientation, but we need 9 at each NStC instance - + p%NumTStC * 6 & ! Jac_nu has 3 for Orientation, but we need 9 at each TStC instance - + p%NumSStC * 6 ! Jac_nu has 3 for Orientation, but we need 9 at each SStC instance - CALL AllocAry( u_op, nu, 'u_op', ErrStat2, ErrMsg2 ) - if (Failed()) return; - end if - - index_next=1 - ! Fixed inputs - u_op(index_next) = u%Yaw; index_next = index_next + 1 - u_op(index_next) = u%YawRate; index_next = index_next + 1 - u_op(index_next) = u%HSS_Spd; index_next = index_next + 1 + integer(IntKi) :: i, j, iVar + + ! if (.not. allocated(u_op)) then + ! call AllocAry( u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2 ); if (Failed()) return + ! end if + + ! call MV_Pack(p%Vars%u, p%iVarYaw, u%Yaw, u_op) + ! call MV_Pack(p%Vars%u, p%iVarYawRate, u%YawRate, u_op) + ! call MV_Pack(p%Vars%u, p%iVarHSS_Spd, u%HSS_Spd, u_op) + + ! !--------------------- + ! ! StC related inputs + ! !--------------------- + + ! ! TODO: add variable indices for these meshes instead of manually counting + ! iVar = p%iVarHSS_Spd + 1 + + ! ! Blade + ! do j = 1, p%NumBStC + ! do i = 1, p%NumBl + ! call MV_Pack(p%Vars%u, iVar, u%BStCMotionMesh(i,j), u_op) + ! iVar = iVar + 6 + ! enddo + ! enddo + + ! ! Nacelle + ! do j = 1, p%NumNStC + ! call MV_Pack(p%Vars%u, iVar, u%NStCMotionMesh(j), u_op) + ! iVar = iVar + 6 + ! enddo + + ! ! Tower + ! do j = 1, p%NumTStC + ! call MV_Pack(p%Vars%u, iVar, u%TStCMotionMesh(j), u_op) + ! iVar = iVar + 6 + ! enddo + + ! ! Sub-structure + ! do j = 1, p%NumSStC + ! call MV_Pack(p%Vars%u, iVar, u%SStCMotionMesh(j), u_op) + ! iVar = iVar + 6 + ! enddo - ! StC related inputs - do j=1,p%NumBStC ! Blade - do i=1,p%NumBl - call PackMotionMesh( u%BStCMotionMesh(i,j), u_op, index_next ) - enddo - enddo - do j=1,p%NumNStC ! Nacelle - call PackMotionMesh( u%NStCMotionMesh(j), u_op, index_next ) - enddo - do j=1,p%NumTStC ! Tower - call PackMotionMesh( u%TStCMotionMesh(j), u_op, index_next ) - enddo - do j=1,p%NumSStC ! Sub-structure - call PackMotionMesh( u%SStCMotionMesh(j), u_op, index_next ) - enddo end subroutine Get_u_op !> Get the operating point outputs and pack subroutine Get_y_op() integer(IntKi) :: i,j,index_next - if (.not. allocated(y_op)) then - CALL AllocAry( y_op, p%Jac_ny, 'y_op', ErrStat2, ErrMsg2 ) - if (Failed()) return; - end if - - index_next=1 - do i=1,size(y%BlPitchCom) - y_op(index_next) = y%BlPitchCom(i) - index_next = index_next + 1 - end do - - y_op(index_next) = y%YawMom; index_next = index_next + 1 - y_op(index_next) = y%GenTrq; index_next = index_next + 1 - y_op(index_next) = y%ElecPwr; index_next = index_next + 1 - - ! StC related outputs - do j=1,p%NumBStC ! Blade - do i=1,p%NumBl - call PackLoadMesh( y%BStCLoadMesh(i,j), y_op, index_next ) - enddo - enddo - do j=1,p%NumNStC ! Nacelle - call PackLoadMesh( y%NStCLoadMesh(j), y_op, index_next ) - enddo - do j=1,p%NumTStC ! Tower - call PackLoadMesh( y%TStCLoadMesh(j), y_op, index_next ) - enddo - do j=1,p%NumSStC ! Sub-structure - call PackLoadMesh( y%SStCLoadMesh(j), y_op, index_next ) - enddo - - ! y%outputs - do i=1,p%NumOuts - y_op(index_next) = y%WriteOutput(i) - index_next = index_next + 1 - end do + ! if (.not. allocated(y_op)) then + ! CALL AllocAry(y_op, p%Vars%ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return + ! end if + + ! call MV_Pack(p%Vars%y, p%iVarBlPitchCom, y%BlPitchCom, y_op) + ! call MV_Pack(p%Vars%y, p%iVarYawMom, y%YawMom, y_op) + ! call MV_Pack(p%Vars%y, p%iVarGenTrq, y%GenTrq, y_op) + ! call MV_Pack(p%Vars%y, p%iVarElecPwr, y%ElecPwr, y_op) + + ! ! StC related outputs + ! do j = 1, p%NumBStC ! Blade + ! do i = 1, p%NumBl + ! call MV_Pack(p%Vars%y, p%iVarBStCLoadMesh(i,j), y%BStCLoadMesh(i,j), y_op) + ! enddo + ! enddo + ! do j = 1, p%NumNStC ! Nacelle + ! call MV_Pack(p%Vars%y, p%iVarNStCLoadMesh(j), y%NStCLoadMesh(j), y_op) + ! enddo + ! do j = 1, p%NumTStC ! Tower + ! call MV_Pack(p%Vars%y, p%iVarTStCLoadMesh(j), y%TStCLoadMesh(j), y_op) + ! enddo + ! do j = 1, p%NumSStC ! Sub-structure + ! call MV_Pack(p%Vars%y, p%iVarSStCLoadMesh(j), y%SStCLoadMesh(j), y_op) + ! enddo + + ! ! y%outputs + ! if (p%iVarWriteOutput > 0) then + ! do i = p%iVarWriteOutput, size(p%Vars%y) + ! call MV_Pack(p%Vars%y, i, y%WriteOutput(p%Vars%y(i)%iUsr(1)), y_op) + ! end do + ! end if end subroutine Get_y_op !> Get the operating point continuous states and pack subroutine Get_x_op() integer(IntKi) :: i,j,k,idx - if (.not. allocated(x_op)) then - CALL AllocAry( x_op, p%Jac_nx, 'x_op', ErrStat2, ErrMsg2 ) - if (Failed()) return; - end if - idx = 0 - do j=1,p%NumBStC ! Blade StC -- displacement and velocity state - do k=1,p%NumBl - x_op(idx+1) = x%BStC(j)%StC_x(1,k) ! x --> x%BStC(j)%StC_x(1,k) - x_op(idx+2) = x%BStC(j)%StC_x(3,k) ! y --> x%BStC(j)%StC_x(3,k) - x_op(idx+3) = x%BStC(j)%StC_x(5,k) ! z --> x%BStC(j)%StC_x(5,k) - x_op(idx+4) = x%BStC(j)%StC_x(2,k) ! dx/dt --> x%BStC(j)%StC_x(2,k) - x_op(idx+5) = x%BStC(j)%StC_x(4,k) ! dy/dt --> x%BStC(j)%StC_x(4,k) - x_op(idx+6) = x%BStC(j)%StC_x(6,k) ! dz/dt --> x%BStC(j)%StC_x(6,k) - idx = idx + 6 - enddo - enddo - do j=1,p%NumNStC ! Nacelle StC -- displacement and velocity state - x_op(idx+1) = x%NStC(j)%StC_x(1,1) ! x --> x%NStC(j)%StC_x(1,1) - x_op(idx+2) = x%NStC(j)%StC_x(3,1) ! y --> x%NStC(j)%StC_x(3,1) - x_op(idx+3) = x%NStC(j)%StC_x(5,1) ! z --> x%NStC(j)%StC_x(5,1) - x_op(idx+4) = x%NStC(j)%StC_x(2,1) ! dx/dt --> x%NStC(j)%StC_x(2,1) - x_op(idx+5) = x%NStC(j)%StC_x(4,1) ! dy/dt --> x%NStC(j)%StC_x(4,1) - x_op(idx+6) = x%NStC(j)%StC_x(6,1) ! dz/dt --> x%NStC(j)%StC_x(6,1) - idx = idx + 6 - enddo - do j=1,p%NumTStC ! Tower StC -- displacement and velocity state - x_op(idx+1) = x%TStC(j)%StC_x(1,1) ! x --> x%TStC(j)%StC_x(1,1) - x_op(idx+2) = x%TStC(j)%StC_x(3,1) ! y --> x%TStC(j)%StC_x(3,1) - x_op(idx+3) = x%TStC(j)%StC_x(5,1) ! z --> x%TStC(j)%StC_x(5,1) - x_op(idx+4) = x%TStC(j)%StC_x(2,1) ! dx/dt --> x%TStC(j)%StC_x(2,1) - x_op(idx+5) = x%TStC(j)%StC_x(4,1) ! dy/dt --> x%TStC(j)%StC_x(4,1) - x_op(idx+6) = x%TStC(j)%StC_x(6,1) ! dz/dt --> x%TStC(j)%StC_x(6,1) - idx = idx + 6 - enddo - do j=1,p%NumSStC ! Substructure StC -- displacement and velocity state - x_op(idx+1) = x%SStC(j)%StC_x(1,1) ! x --> x%SStC(j)%StC_x(1,1) - x_op(idx+2) = x%SStC(j)%StC_x(3,1) ! y --> x%SStC(j)%StC_x(3,1) - x_op(idx+3) = x%SStC(j)%StC_x(5,1) ! z --> x%SStC(j)%StC_x(5,1) - x_op(idx+4) = x%SStC(j)%StC_x(2,1) ! dx/dt --> x%SStC(j)%StC_x(2,1) - x_op(idx+5) = x%SStC(j)%StC_x(4,1) ! dy/dt --> x%SStC(j)%StC_x(4,1) - x_op(idx+6) = x%SStC(j)%StC_x(6,1) ! dz/dt --> x%SStC(j)%StC_x(6,1) - idx = idx + 6 - enddo + ! if (.not. allocated(x_op)) then + ! CALL AllocAry( x_op, p%Jac_nx, 'x_op', ErrStat2, ErrMsg2 ) + ! if (Failed()) return; + ! end if + ! idx = 0 + ! do j=1,p%NumBStC ! Blade StC -- displacement and velocity state + ! do k=1,p%NumBl + ! x_op(idx+1) = x%BStC(j)%StC_x(1,k) ! x --> x%BStC(j)%StC_x(1,k) + ! x_op(idx+2) = x%BStC(j)%StC_x(3,k) ! y --> x%BStC(j)%StC_x(3,k) + ! x_op(idx+3) = x%BStC(j)%StC_x(5,k) ! z --> x%BStC(j)%StC_x(5,k) + ! x_op(idx+4) = x%BStC(j)%StC_x(2,k) ! dx/dt --> x%BStC(j)%StC_x(2,k) + ! x_op(idx+5) = x%BStC(j)%StC_x(4,k) ! dy/dt --> x%BStC(j)%StC_x(4,k) + ! x_op(idx+6) = x%BStC(j)%StC_x(6,k) ! dz/dt --> x%BStC(j)%StC_x(6,k) + ! idx = idx + 6 + ! enddo + ! enddo + ! do j=1,p%NumNStC ! Nacelle StC -- displacement and velocity state + ! x_op(idx+1) = x%NStC(j)%StC_x(1,1) ! x --> x%NStC(j)%StC_x(1,1) + ! x_op(idx+2) = x%NStC(j)%StC_x(3,1) ! y --> x%NStC(j)%StC_x(3,1) + ! x_op(idx+3) = x%NStC(j)%StC_x(5,1) ! z --> x%NStC(j)%StC_x(5,1) + ! x_op(idx+4) = x%NStC(j)%StC_x(2,1) ! dx/dt --> x%NStC(j)%StC_x(2,1) + ! x_op(idx+5) = x%NStC(j)%StC_x(4,1) ! dy/dt --> x%NStC(j)%StC_x(4,1) + ! x_op(idx+6) = x%NStC(j)%StC_x(6,1) ! dz/dt --> x%NStC(j)%StC_x(6,1) + ! idx = idx + 6 + ! enddo + ! do j=1,p%NumTStC ! Tower StC -- displacement and velocity state + ! x_op(idx+1) = x%TStC(j)%StC_x(1,1) ! x --> x%TStC(j)%StC_x(1,1) + ! x_op(idx+2) = x%TStC(j)%StC_x(3,1) ! y --> x%TStC(j)%StC_x(3,1) + ! x_op(idx+3) = x%TStC(j)%StC_x(5,1) ! z --> x%TStC(j)%StC_x(5,1) + ! x_op(idx+4) = x%TStC(j)%StC_x(2,1) ! dx/dt --> x%TStC(j)%StC_x(2,1) + ! x_op(idx+5) = x%TStC(j)%StC_x(4,1) ! dy/dt --> x%TStC(j)%StC_x(4,1) + ! x_op(idx+6) = x%TStC(j)%StC_x(6,1) ! dz/dt --> x%TStC(j)%StC_x(6,1) + ! idx = idx + 6 + ! enddo + ! do j=1,p%NumSStC ! Substructure StC -- displacement and velocity state + ! x_op(idx+1) = x%SStC(j)%StC_x(1,1) ! x --> x%SStC(j)%StC_x(1,1) + ! x_op(idx+2) = x%SStC(j)%StC_x(3,1) ! y --> x%SStC(j)%StC_x(3,1) + ! x_op(idx+3) = x%SStC(j)%StC_x(5,1) ! z --> x%SStC(j)%StC_x(5,1) + ! x_op(idx+4) = x%SStC(j)%StC_x(2,1) ! dx/dt --> x%SStC(j)%StC_x(2,1) + ! x_op(idx+5) = x%SStC(j)%StC_x(4,1) ! dy/dt --> x%SStC(j)%StC_x(4,1) + ! x_op(idx+6) = x%SStC(j)%StC_x(6,1) ! dz/dt --> x%SStC(j)%StC_x(6,1) + ! idx = idx + 6 + ! enddo end subroutine Get_x_op !> Get the operating point continuous states derivatives and pack - !! rather than copy the logic in CalcContStateDeriv for the StCs, we'll just - !! call it directly + ! rather than copy the logic in CalcContStateDeriv for the StCs, we'll just + ! call it directly subroutine Get_dx_op() integer(IntKi) :: i,j,k,idx type(SrvD_ContinuousStateType) :: dx !< derivative of continuous states at operating point - if (.not. allocated(dx_op)) then - CALL AllocAry( dx_op, p%Jac_nx, 'dx_op', ErrStat2, ErrMsg2 ) - if (Failed()) return; - end if - call SrvD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dx, ErrStat2, ErrMsg2 ) - if (Failed()) then - call SrvD_DestroyContState( dx, ErrStat2, ErrMsg2) - return - end if - idx = 0 - do j=1,p%NumBStC ! Blade StC -- displacement and velocity state - do k=1,p%NumBl - dx_op(idx+1) = dx%BStC(j)%StC_x(1,k) ! x --> dx%BStC(j)%StC_x(1,k) - dx_op(idx+2) = dx%BStC(j)%StC_x(3,k) ! y --> dx%BStC(j)%StC_x(3,k) - dx_op(idx+3) = dx%BStC(j)%StC_x(5,k) ! z --> dx%BStC(j)%StC_x(5,k) - dx_op(idx+4) = dx%BStC(j)%StC_x(2,k) ! dx/dt --> dx%BStC(j)%StC_x(2,k) - dx_op(idx+5) = dx%BStC(j)%StC_x(4,k) ! dy/dt --> dx%BStC(j)%StC_x(4,k) - dx_op(idx+6) = dx%BStC(j)%StC_x(6,k) ! dz/dt --> dx%BStC(j)%StC_x(6,k) - idx = idx + 6 - enddo - enddo - do j=1,p%NumNStC ! Nacelle StC -- displacement and velocity state - dx_op(idx+1) = dx%NStC(j)%StC_x(1,1) ! x --> dx%NStC(j)%StC_x(1,1) - dx_op(idx+2) = dx%NStC(j)%StC_x(3,1) ! y --> dx%NStC(j)%StC_x(3,1) - dx_op(idx+3) = dx%NStC(j)%StC_x(5,1) ! z --> dx%NStC(j)%StC_x(5,1) - dx_op(idx+4) = dx%NStC(j)%StC_x(2,1) ! dx/dt --> dx%NStC(j)%StC_x(2,1) - dx_op(idx+5) = dx%NStC(j)%StC_x(4,1) ! dy/dt --> dx%NStC(j)%StC_x(4,1) - dx_op(idx+6) = dx%NStC(j)%StC_x(6,1) ! dz/dt --> dx%NStC(j)%StC_x(6,1) - idx = idx + 6 - enddo - do j=1,p%NumTStC ! Tower StC -- displacement and velocity state - dx_op(idx+1) = dx%TStC(j)%StC_x(1,1) ! x --> dx%TStC(j)%StC_x(1,1) - dx_op(idx+2) = dx%TStC(j)%StC_x(3,1) ! y --> dx%TStC(j)%StC_x(3,1) - dx_op(idx+3) = dx%TStC(j)%StC_x(5,1) ! z --> dx%TStC(j)%StC_x(5,1) - dx_op(idx+4) = dx%TStC(j)%StC_x(2,1) ! dx/dt --> dx%TStC(j)%StC_x(2,1) - dx_op(idx+5) = dx%TStC(j)%StC_x(4,1) ! dy/dt --> dx%TStC(j)%StC_x(4,1) - dx_op(idx+6) = dx%TStC(j)%StC_x(6,1) ! dz/dt --> dx%TStC(j)%StC_x(6,1) - idx = idx + 6 - enddo - do j=1,p%NumSStC ! Substructure StC -- displacement and velocity state - dx_op(idx+1) = dx%SStC(j)%StC_x(1,1) ! x --> dx%SStC(j)%StC_x(1,1) - dx_op(idx+2) = dx%SStC(j)%StC_x(3,1) ! y --> dx%SStC(j)%StC_x(3,1) - dx_op(idx+3) = dx%SStC(j)%StC_x(5,1) ! z --> dx%SStC(j)%StC_x(5,1) - dx_op(idx+4) = dx%SStC(j)%StC_x(2,1) ! dx/dt --> dx%SStC(j)%StC_x(2,1) - dx_op(idx+5) = dx%SStC(j)%StC_x(4,1) ! dy/dt --> dx%SStC(j)%StC_x(4,1) - dx_op(idx+6) = dx%SStC(j)%StC_x(6,1) ! dz/dt --> dx%SStC(j)%StC_x(6,1) - idx = idx + 6 - enddo - ! clean up - call SrvD_DestroyContState( dx, ErrStat2, ErrMsg2) + ! if (.not. allocated(dx_op)) then + ! CALL AllocAry( dx_op, p%Jac_nx, 'dx_op', ErrStat2, ErrMsg2 ) + ! if (Failed()) return; + ! end if + ! call SrvD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dx, ErrStat2, ErrMsg2 ) + ! if (Failed()) then + ! call SrvD_DestroyContState( dx, ErrStat2, ErrMsg2) + ! return + ! end if + ! idx = 0 + ! do j=1,p%NumBStC ! Blade StC -- displacement and velocity state + ! do k=1,p%NumBl + ! dx_op(idx+1) = dx%BStC(j)%StC_x(1,k) ! x --> dx%BStC(j)%StC_x(1,k) + ! dx_op(idx+2) = dx%BStC(j)%StC_x(3,k) ! y --> dx%BStC(j)%StC_x(3,k) + ! dx_op(idx+3) = dx%BStC(j)%StC_x(5,k) ! z --> dx%BStC(j)%StC_x(5,k) + ! dx_op(idx+4) = dx%BStC(j)%StC_x(2,k) ! dx/dt --> dx%BStC(j)%StC_x(2,k) + ! dx_op(idx+5) = dx%BStC(j)%StC_x(4,k) ! dy/dt --> dx%BStC(j)%StC_x(4,k) + ! dx_op(idx+6) = dx%BStC(j)%StC_x(6,k) ! dz/dt --> dx%BStC(j)%StC_x(6,k) + ! idx = idx + 6 + ! enddo + ! enddo + ! do j=1,p%NumNStC ! Nacelle StC -- displacement and velocity state + ! dx_op(idx+1) = dx%NStC(j)%StC_x(1,1) ! x --> dx%NStC(j)%StC_x(1,1) + ! dx_op(idx+2) = dx%NStC(j)%StC_x(3,1) ! y --> dx%NStC(j)%StC_x(3,1) + ! dx_op(idx+3) = dx%NStC(j)%StC_x(5,1) ! z --> dx%NStC(j)%StC_x(5,1) + ! dx_op(idx+4) = dx%NStC(j)%StC_x(2,1) ! dx/dt --> dx%NStC(j)%StC_x(2,1) + ! dx_op(idx+5) = dx%NStC(j)%StC_x(4,1) ! dy/dt --> dx%NStC(j)%StC_x(4,1) + ! dx_op(idx+6) = dx%NStC(j)%StC_x(6,1) ! dz/dt --> dx%NStC(j)%StC_x(6,1) + ! idx = idx + 6 + ! enddo + ! do j=1,p%NumTStC ! Tower StC -- displacement and velocity state + ! dx_op(idx+1) = dx%TStC(j)%StC_x(1,1) ! x --> dx%TStC(j)%StC_x(1,1) + ! dx_op(idx+2) = dx%TStC(j)%StC_x(3,1) ! y --> dx%TStC(j)%StC_x(3,1) + ! dx_op(idx+3) = dx%TStC(j)%StC_x(5,1) ! z --> dx%TStC(j)%StC_x(5,1) + ! dx_op(idx+4) = dx%TStC(j)%StC_x(2,1) ! dx/dt --> dx%TStC(j)%StC_x(2,1) + ! dx_op(idx+5) = dx%TStC(j)%StC_x(4,1) ! dy/dt --> dx%TStC(j)%StC_x(4,1) + ! dx_op(idx+6) = dx%TStC(j)%StC_x(6,1) ! dz/dt --> dx%TStC(j)%StC_x(6,1) + ! idx = idx + 6 + ! enddo + ! do j=1,p%NumSStC ! Substructure StC -- displacement and velocity state + ! dx_op(idx+1) = dx%SStC(j)%StC_x(1,1) ! x --> dx%SStC(j)%StC_x(1,1) + ! dx_op(idx+2) = dx%SStC(j)%StC_x(3,1) ! y --> dx%SStC(j)%StC_x(3,1) + ! dx_op(idx+3) = dx%SStC(j)%StC_x(5,1) ! z --> dx%SStC(j)%StC_x(5,1) + ! dx_op(idx+4) = dx%SStC(j)%StC_x(2,1) ! dx/dt --> dx%SStC(j)%StC_x(2,1) + ! dx_op(idx+5) = dx%SStC(j)%StC_x(4,1) ! dy/dt --> dx%SStC(j)%StC_x(4,1) + ! dx_op(idx+6) = dx%SStC(j)%StC_x(6,1) ! dz/dt --> dx%SStC(j)%StC_x(6,1) + ! idx = idx + 6 + ! enddo + ! ! clean up + ! call SrvD_DestroyContState( dx, ErrStat2, ErrMsg2) end subroutine Get_dx_op END SUBROUTINE SrvD_GetOP @@ -4761,6 +5011,11 @@ END SUBROUTINE Torque_ValidateData !> This routine performs the checks on inputs for the high-speed shaft brake. SUBROUTINE HSSBr_ValidateData( ) + ! TODO: Implement brake in tight-coupling scheme + IF (InputFileData%HSSBrMode /= ControlMode_NONE) then + CALL SetErrStat( ErrID_Fatal, 'HSSBrMode must be 0 for tight-coupling.', ErrStat, ErrMsg, RoutineName ) + end if + ! Some special checks based on whether inputs will come from external source (e.g., Simulink, LabVIEW) IF ( .NOT. Cmpl4SFun .AND. .NOT. Cmpl4LV ) THEN diff --git a/modules/servodyn/src/ServoDyn_Registry.txt b/modules/servodyn/src/ServoDyn_Registry.txt index 240fee5260..f61e0c9263 100644 --- a/modules/servodyn/src/ServoDyn_Registry.txt +++ b/modules/servodyn/src/ServoDyn_Registry.txt @@ -71,6 +71,7 @@ typedef ^ InitInputType ReKi URefLid - - - "Reference average wind spee 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" - +typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" - typedef ^ InitOutputType IntKi CouplingScheme - - - "Switch that indicates if a particular coupling scheme is required" - typedef ^ InitOutputType Logical UseHSSBrake - - - "flag to determine if high-speed shaft brake is potentially used (true=yes)" - # Linearization @@ -340,27 +341,6 @@ typedef ^ SrvD_ModuleMapType MeshMapType NStC_Frc2_y_NStC {:} - - "Map loads: m% typedef ^ SrvD_ModuleMapType MeshMapType TStC_Frc2_y_TStC {:} - - "Map loads: m%y_TStCLoadMesh to y%TStC%LoadMesh" typedef ^ SrvD_ModuleMapType MeshMapType SStC_Frc2_y_SStC {:} - - "Map loads: m%y_SStCLoadMesh to y%SStC%LoadMesh" -# ..... Misc Variables ................................................................................................................ -typedef ^ MiscVarType DbKi LastTimeCalled - - - "last time the CalcOutput/Bladed DLL was called" s -typedef ^ MiscVarType BladedDLLType dll_data - - - "data used for Bladed DLL" - -typedef ^ MiscVarType logical FirstWarn - - - "Whether or not this is the first warning about the DLL being called without Explicit-Loose coupling." - -typedef ^ MiscVarType DbKi LastTimeFiltered - - - "last time the CalcOutput/Bladed DLL was filtered" s -typedef ^ MiscVarType ReKi xd_BlPitchFilter {:} - - "blade pitch filter" - -typedef ^ MiscVarType StC_MiscVarType BStC {:} - - "StC module misc vars - blade" - -typedef ^ MiscVarType StC_MiscVarType NStC {:} - - "StC module misc vars - nacelle" - -typedef ^ MiscVarType StC_MiscVarType TStC {:} - - "StC module misc vars - tower" - -typedef ^ MiscVarType StC_MiscVarType SStC {:} - - "StC module misc vars - substructure" - -typedef ^ MiscVarType StC_InputType u_BStC {:}{:} - - "StC module inputs - blade size:(interpOrder,NumBStC)" - -typedef ^ MiscVarType StC_InputType u_NStC {:}{:} - - "StC module inputs - nacelle size:(interpOrder,NumNStC)" - -typedef ^ MiscVarType StC_InputType u_TStC {:}{:} - - "StC module inputs - tower size:(interpOrder,NumTStC)" - -typedef ^ MiscVarType StC_InputType u_SStC {:}{:} - - "StC module inputs - substructure size:(interpOrder,NumSStC)" - -typedef ^ MiscVarType StC_OutputType y_BStC {:} - - "StC module outputs - blade" - -typedef ^ MiscVarType StC_OutputType y_NStC {:} - - "StC module outputs - nacelle" - -typedef ^ MiscVarType StC_OutputType y_TStC {:} - - "StC module outputs - tower" - -typedef ^ MiscVarType StC_OutputType y_SStC {:} - - "StC module outputs - substructure" - -typedef ^ MiscVarType SrvD_ModuleMapType SrvD_MeshMap - - - "Mesh mapping from inputs/output meshes to StC input/output meshes" - -typedef ^ MiscVarType IntKi PrevTstepNcall - -1 - "Previous timestep N for tracking when in predictor/corrector loop for setting StC u values" - - # ..... Parameters ................................................................................................................ # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: @@ -494,7 +474,8 @@ typedef ^ ParameterType IntKi NumBeam - - - "Number of beams" - typedef ^ ParameterType IntKi NumPulseGate - - - "Number of pulse gates" - typedef ^ ParameterType ReKi PulseSpacing - - - "Distance between range gates" m typedef ^ ParameterType ReKi URefLid - - - "Reference average wind speed for the lidar" m/s - +# parameters for variables +typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" - # ..... Inputs .................................................................................................................... @@ -574,3 +555,30 @@ typedef ^ OutputType MeshType NStCLoadMesh {:} - - "StC module nacelle outp typedef ^ OutputType MeshType TStCLoadMesh {:} - - "StC module tower output load mesh" - typedef ^ OutputType MeshType SStCLoadMesh {:} - - "StC module substructure output load mesh" - typedef ^ OutputType SiKi toSC {:} - - "A swap array: used to pass output data from the DLL controller to the supercontroller" - + + +# ..... Misc Variables ................................................................................................................ +typedef ^ MiscVarType DbKi LastTimeCalled - - - "last time the CalcOutput/Bladed DLL was called" s +typedef ^ MiscVarType BladedDLLType dll_data - - - "data used for Bladed DLL" - +typedef ^ MiscVarType logical FirstWarn - - - "Whether or not this is the first warning about the DLL being called without Explicit-Loose coupling." - +typedef ^ MiscVarType DbKi LastTimeFiltered - - - "last time the CalcOutput/Bladed DLL was filtered" s +typedef ^ MiscVarType ReKi xd_BlPitchFilter {:} - - "blade pitch filter" - +typedef ^ MiscVarType StC_MiscVarType BStC {:} - - "StC module misc vars - blade" - +typedef ^ MiscVarType StC_MiscVarType NStC {:} - - "StC module misc vars - nacelle" - +typedef ^ MiscVarType StC_MiscVarType TStC {:} - - "StC module misc vars - tower" - +typedef ^ MiscVarType StC_MiscVarType SStC {:} - - "StC module misc vars - substructure" - +typedef ^ MiscVarType StC_InputType u_BStC {:}{:} - - "StC module inputs - blade size:(interpOrder,NumBStC)" - +typedef ^ MiscVarType StC_InputType u_NStC {:}{:} - - "StC module inputs - nacelle size:(interpOrder,NumNStC)" - +typedef ^ MiscVarType StC_InputType u_TStC {:}{:} - - "StC module inputs - tower size:(interpOrder,NumTStC)" - +typedef ^ MiscVarType StC_InputType u_SStC {:}{:} - - "StC module inputs - substructure size:(interpOrder,NumSStC)" - +typedef ^ MiscVarType StC_OutputType y_BStC {:} - - "StC module outputs - blade" - +typedef ^ MiscVarType StC_OutputType y_NStC {:} - - "StC module outputs - nacelle" - +typedef ^ MiscVarType StC_OutputType y_TStC {:} - - "StC module outputs - tower" - +typedef ^ MiscVarType StC_OutputType y_SStC {:} - - "StC module outputs - substructure" - +typedef ^ MiscVarType SrvD_ModuleMapType SrvD_MeshMap - - - "Mesh mapping from inputs/output meshes to StC input/output meshes" - +typedef ^ MiscVarType IntKi PrevTstepNcall - -1 - "Previous timestep N for tracking when in predictor/corrector loop for setting StC u values" - +typedef ^ MiscVarType ModJacType Jac - - - "Jacobian matrices and arrays corresponding to module variables" +typedef ^ MiscVarType SrvD_ContinuousStateType x_perturb - - - "Continuous state for perturbation in Jacobian routines" - +typedef ^ MiscVarType SrvD_ContinuousStateType dxdt_lin - - - "Continuous state derivative for output in Jacobian routines" - +typedef ^ MiscVarType SrvD_InputType u_perturb - - - "Input for perturbation in Jacobian routines" - +typedef ^ MiscVarType SrvD_OutputType y_lin - - - "Output for output in Jacobian routines" - diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index d8b6eb4b44..8360ad2b17 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -90,6 +90,7 @@ MODULE ServoDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] INTEGER(IntKi) :: CouplingScheme = 0_IntKi !< Switch that indicates if a particular coupling scheme is required [-] LOGICAL :: UseHSSBrake = .false. !< flag to determine if high-speed shaft brake is potentially used (true=yes) [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] @@ -351,29 +352,6 @@ MODULE ServoDyn_Types TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: SStC_Frc2_y_SStC !< Map loads: m%y_SStCLoadMesh to y%SStC%LoadMesh [-] END TYPE SrvD_ModuleMapType ! ======================= -! ========= SrvD_MiscVarType ======= - TYPE, PUBLIC :: SrvD_MiscVarType - REAL(DbKi) :: LastTimeCalled = 0.0_R8Ki !< last time the CalcOutput/Bladed DLL was called [s] - TYPE(BladedDLLType) :: dll_data !< data used for Bladed DLL [-] - LOGICAL :: FirstWarn = .false. !< Whether or not this is the first warning about the DLL being called without Explicit-Loose coupling. [-] - REAL(DbKi) :: LastTimeFiltered = 0.0_R8Ki !< last time the CalcOutput/Bladed DLL was filtered [s] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: xd_BlPitchFilter !< blade pitch filter [-] - TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module misc vars - blade [-] - TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module misc vars - nacelle [-] - TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: TStC !< StC module misc vars - tower [-] - TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: SStC !< StC module misc vars - substructure [-] - TYPE(StC_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_BStC !< StC module inputs - blade size:(interpOrder,NumBStC) [-] - TYPE(StC_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_NStC !< StC module inputs - nacelle size:(interpOrder,NumNStC) [-] - TYPE(StC_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_TStC !< StC module inputs - tower size:(interpOrder,NumTStC) [-] - TYPE(StC_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_SStC !< StC module inputs - substructure size:(interpOrder,NumSStC) [-] - TYPE(StC_OutputType) , DIMENSION(:), ALLOCATABLE :: y_BStC !< StC module outputs - blade [-] - TYPE(StC_OutputType) , DIMENSION(:), ALLOCATABLE :: y_NStC !< StC module outputs - nacelle [-] - TYPE(StC_OutputType) , DIMENSION(:), ALLOCATABLE :: y_TStC !< StC module outputs - tower [-] - TYPE(StC_OutputType) , DIMENSION(:), ALLOCATABLE :: y_SStC !< StC module outputs - substructure [-] - TYPE(SrvD_ModuleMapType) :: SrvD_MeshMap !< Mesh mapping from inputs/output meshes to StC input/output meshes [-] - INTEGER(IntKi) :: PrevTstepNcall = -1 !< Previous timestep N for tracking when in predictor/corrector loop for setting StC u values [-] - END TYPE SrvD_MiscVarType -! ======================= ! ========= SrvD_ParameterType ======= TYPE, PUBLIC :: SrvD_ParameterType REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] @@ -500,6 +478,7 @@ MODULE ServoDyn_Types INTEGER(IntKi) :: NumPulseGate = 0_IntKi !< Number of pulse gates [-] REAL(ReKi) :: PulseSpacing = 0.0_ReKi !< Distance between range gates [m] REAL(ReKi) :: URefLid = 0.0_ReKi !< Reference average wind speed for the lidar [m/s] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] END TYPE SrvD_ParameterType ! ======================= ! ========= SrvD_InputType ======= @@ -577,7 +556,113 @@ MODULE ServoDyn_Types REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: toSC !< A swap array: used to pass output data from the DLL controller to the supercontroller [-] END TYPE SrvD_OutputType ! ======================= -CONTAINS +! ========= SrvD_MiscVarType ======= + TYPE, PUBLIC :: SrvD_MiscVarType + REAL(DbKi) :: LastTimeCalled = 0.0_R8Ki !< last time the CalcOutput/Bladed DLL was called [s] + TYPE(BladedDLLType) :: dll_data !< data used for Bladed DLL [-] + LOGICAL :: FirstWarn = .false. !< Whether or not this is the first warning about the DLL being called without Explicit-Loose coupling. [-] + REAL(DbKi) :: LastTimeFiltered = 0.0_R8Ki !< last time the CalcOutput/Bladed DLL was filtered [s] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: xd_BlPitchFilter !< blade pitch filter [-] + TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module misc vars - blade [-] + TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module misc vars - nacelle [-] + TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: TStC !< StC module misc vars - tower [-] + TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: SStC !< StC module misc vars - substructure [-] + TYPE(StC_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_BStC !< StC module inputs - blade size:(interpOrder,NumBStC) [-] + TYPE(StC_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_NStC !< StC module inputs - nacelle size:(interpOrder,NumNStC) [-] + TYPE(StC_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_TStC !< StC module inputs - tower size:(interpOrder,NumTStC) [-] + TYPE(StC_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_SStC !< StC module inputs - substructure size:(interpOrder,NumSStC) [-] + TYPE(StC_OutputType) , DIMENSION(:), ALLOCATABLE :: y_BStC !< StC module outputs - blade [-] + TYPE(StC_OutputType) , DIMENSION(:), ALLOCATABLE :: y_NStC !< StC module outputs - nacelle [-] + TYPE(StC_OutputType) , DIMENSION(:), ALLOCATABLE :: y_TStC !< StC module outputs - tower [-] + TYPE(StC_OutputType) , DIMENSION(:), ALLOCATABLE :: y_SStC !< StC module outputs - substructure [-] + TYPE(SrvD_ModuleMapType) :: SrvD_MeshMap !< Mesh mapping from inputs/output meshes to StC input/output meshes [-] + INTEGER(IntKi) :: PrevTstepNcall = -1 !< Previous timestep N for tracking when in predictor/corrector loop for setting StC u values [-] + TYPE(ModJacType) :: Jac !< Jacobian matrices and arrays corresponding to module variables [-] + TYPE(SrvD_ContinuousStateType) :: x_perturb !< Continuous state for perturbation in Jacobian routines [-] + TYPE(SrvD_ContinuousStateType) :: dxdt_lin !< Continuous state derivative for output in Jacobian routines [-] + TYPE(SrvD_InputType) :: u_perturb !< Input for perturbation in Jacobian routines [-] + TYPE(SrvD_OutputType) :: y_lin !< Output for output in Jacobian routines [-] + END TYPE SrvD_MiscVarType +! ======================= + integer(IntKi), public, parameter :: SrvD_x_DummyContState = 1 ! SrvD%DummyContState + integer(IntKi), public, parameter :: SrvD_x_BStC_StC_x = 2 ! SrvD%BStC(DL%i1)%StC_x + integer(IntKi), public, parameter :: SrvD_x_NStC_StC_x = 3 ! SrvD%NStC(DL%i1)%StC_x + integer(IntKi), public, parameter :: SrvD_x_TStC_StC_x = 4 ! SrvD%TStC(DL%i1)%StC_x + integer(IntKi), public, parameter :: SrvD_x_SStC_StC_x = 5 ! SrvD%SStC(DL%i1)%StC_x + integer(IntKi), public, parameter :: SrvD_z_DummyConstrState = 6 ! SrvD%DummyConstrState + integer(IntKi), public, parameter :: SrvD_z_BStC_DummyConstrState = 7 ! SrvD%BStC(DL%i1)%DummyConstrState + integer(IntKi), public, parameter :: SrvD_z_NStC_DummyConstrState = 8 ! SrvD%NStC(DL%i1)%DummyConstrState + integer(IntKi), public, parameter :: SrvD_z_TStC_DummyConstrState = 9 ! SrvD%TStC(DL%i1)%DummyConstrState + integer(IntKi), public, parameter :: SrvD_z_SStC_DummyConstrState = 10 ! SrvD%SStC(DL%i1)%DummyConstrState + integer(IntKi), public, parameter :: SrvD_u_BlPitch = 11 ! SrvD%BlPitch + integer(IntKi), public, parameter :: SrvD_u_Yaw = 12 ! SrvD%Yaw + integer(IntKi), public, parameter :: SrvD_u_YawRate = 13 ! SrvD%YawRate + integer(IntKi), public, parameter :: SrvD_u_LSS_Spd = 14 ! SrvD%LSS_Spd + integer(IntKi), public, parameter :: SrvD_u_HSS_Spd = 15 ! SrvD%HSS_Spd + integer(IntKi), public, parameter :: SrvD_u_RotSpeed = 16 ! SrvD%RotSpeed + integer(IntKi), public, parameter :: SrvD_u_ExternalYawPosCom = 17 ! SrvD%ExternalYawPosCom + integer(IntKi), public, parameter :: SrvD_u_ExternalYawRateCom = 18 ! SrvD%ExternalYawRateCom + integer(IntKi), public, parameter :: SrvD_u_ExternalBlPitchCom = 19 ! SrvD%ExternalBlPitchCom + integer(IntKi), public, parameter :: SrvD_u_ExternalGenTrq = 20 ! SrvD%ExternalGenTrq + integer(IntKi), public, parameter :: SrvD_u_ExternalElecPwr = 21 ! SrvD%ExternalElecPwr + integer(IntKi), public, parameter :: SrvD_u_ExternalHSSBrFrac = 22 ! SrvD%ExternalHSSBrFrac + integer(IntKi), public, parameter :: SrvD_u_ExternalBlAirfoilCom = 23 ! SrvD%ExternalBlAirfoilCom + integer(IntKi), public, parameter :: SrvD_u_ExternalCableDeltaL = 24 ! SrvD%ExternalCableDeltaL + integer(IntKi), public, parameter :: SrvD_u_ExternalCableDeltaLdot = 25 ! SrvD%ExternalCableDeltaLdot + integer(IntKi), public, parameter :: SrvD_u_TwrAccel = 26 ! SrvD%TwrAccel + integer(IntKi), public, parameter :: SrvD_u_YawErr = 27 ! SrvD%YawErr + integer(IntKi), public, parameter :: SrvD_u_WindDir = 28 ! SrvD%WindDir + integer(IntKi), public, parameter :: SrvD_u_RootMyc = 29 ! SrvD%RootMyc + integer(IntKi), public, parameter :: SrvD_u_YawBrTAxp = 30 ! SrvD%YawBrTAxp + integer(IntKi), public, parameter :: SrvD_u_YawBrTAyp = 31 ! SrvD%YawBrTAyp + integer(IntKi), public, parameter :: SrvD_u_LSSTipPxa = 32 ! SrvD%LSSTipPxa + integer(IntKi), public, parameter :: SrvD_u_RootMxc = 33 ! SrvD%RootMxc + integer(IntKi), public, parameter :: SrvD_u_LSSTipMxa = 34 ! SrvD%LSSTipMxa + integer(IntKi), public, parameter :: SrvD_u_LSSTipMya = 35 ! SrvD%LSSTipMya + integer(IntKi), public, parameter :: SrvD_u_LSSTipMza = 36 ! SrvD%LSSTipMza + integer(IntKi), public, parameter :: SrvD_u_LSSTipMys = 37 ! SrvD%LSSTipMys + integer(IntKi), public, parameter :: SrvD_u_LSSTipMzs = 38 ! SrvD%LSSTipMzs + integer(IntKi), public, parameter :: SrvD_u_YawBrMyn = 39 ! SrvD%YawBrMyn + integer(IntKi), public, parameter :: SrvD_u_YawBrMzn = 40 ! SrvD%YawBrMzn + integer(IntKi), public, parameter :: SrvD_u_NcIMURAxs = 41 ! SrvD%NcIMURAxs + integer(IntKi), public, parameter :: SrvD_u_NcIMURAys = 42 ! SrvD%NcIMURAys + integer(IntKi), public, parameter :: SrvD_u_NcIMURAzs = 43 ! SrvD%NcIMURAzs + integer(IntKi), public, parameter :: SrvD_u_RotPwr = 44 ! SrvD%RotPwr + integer(IntKi), public, parameter :: SrvD_u_HorWindV = 45 ! SrvD%HorWindV + integer(IntKi), public, parameter :: SrvD_u_YawAngle = 46 ! SrvD%YawAngle + integer(IntKi), public, parameter :: SrvD_u_LSShftFxa = 47 ! SrvD%LSShftFxa + integer(IntKi), public, parameter :: SrvD_u_LSShftFys = 48 ! SrvD%LSShftFys + integer(IntKi), public, parameter :: SrvD_u_LSShftFzs = 49 ! SrvD%LSShftFzs + integer(IntKi), public, parameter :: SrvD_u_fromSC = 50 ! SrvD%fromSC + integer(IntKi), public, parameter :: SrvD_u_fromSCglob = 51 ! SrvD%fromSCglob + integer(IntKi), public, parameter :: SrvD_u_PtfmMotionMesh = 52 ! SrvD%PtfmMotionMesh + integer(IntKi), public, parameter :: SrvD_u_BStCMotionMesh = 53 ! SrvD%BStCMotionMesh(DL%i1, DL%i2) + integer(IntKi), public, parameter :: SrvD_u_NStCMotionMesh = 54 ! SrvD%NStCMotionMesh(DL%i1) + integer(IntKi), public, parameter :: SrvD_u_TStCMotionMesh = 55 ! SrvD%TStCMotionMesh(DL%i1) + integer(IntKi), public, parameter :: SrvD_u_SStCMotionMesh = 56 ! SrvD%SStCMotionMesh(DL%i1) + integer(IntKi), public, parameter :: SrvD_u_LidSpeed = 57 ! SrvD%LidSpeed + integer(IntKi), public, parameter :: SrvD_u_MsrPositionsX = 58 ! SrvD%MsrPositionsX + integer(IntKi), public, parameter :: SrvD_u_MsrPositionsY = 59 ! SrvD%MsrPositionsY + integer(IntKi), public, parameter :: SrvD_u_MsrPositionsZ = 60 ! SrvD%MsrPositionsZ + integer(IntKi), public, parameter :: SrvD_y_WriteOutput = 61 ! SrvD%WriteOutput + integer(IntKi), public, parameter :: SrvD_y_BlPitchCom = 62 ! SrvD%BlPitchCom + integer(IntKi), public, parameter :: SrvD_y_BlAirfoilCom = 63 ! SrvD%BlAirfoilCom + integer(IntKi), public, parameter :: SrvD_y_YawMom = 64 ! SrvD%YawMom + integer(IntKi), public, parameter :: SrvD_y_YawPosCom = 65 ! SrvD%YawPosCom + integer(IntKi), public, parameter :: SrvD_y_YawRateCom = 66 ! SrvD%YawRateCom + integer(IntKi), public, parameter :: SrvD_y_GenTrq = 67 ! SrvD%GenTrq + integer(IntKi), public, parameter :: SrvD_y_HSSBrTrqC = 68 ! SrvD%HSSBrTrqC + integer(IntKi), public, parameter :: SrvD_y_ElecPwr = 69 ! SrvD%ElecPwr + integer(IntKi), public, parameter :: SrvD_y_TBDrCon = 70 ! SrvD%TBDrCon + integer(IntKi), public, parameter :: SrvD_y_CableDeltaL = 71 ! SrvD%CableDeltaL + integer(IntKi), public, parameter :: SrvD_y_CableDeltaLdot = 72 ! SrvD%CableDeltaLdot + integer(IntKi), public, parameter :: SrvD_y_BStCLoadMesh = 73 ! SrvD%BStCLoadMesh(DL%i1, DL%i2) + integer(IntKi), public, parameter :: SrvD_y_NStCLoadMesh = 74 ! SrvD%NStCLoadMesh(DL%i1) + integer(IntKi), public, parameter :: SrvD_y_TStCLoadMesh = 75 ! SrvD%TStCLoadMesh(DL%i1) + integer(IntKi), public, parameter :: SrvD_y_SStCLoadMesh = 76 ! SrvD%SStCLoadMesh(DL%i1) + integer(IntKi), public, parameter :: SrvD_y_toSC = 77 ! SrvD%toSC + +contains subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(SrvD_InitInputType), intent(in) :: SrcInitInputData @@ -974,6 +1059,7 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + DstInitOutputData%Vars => SrcInitOutputData%Vars DstInitOutputData%CouplingScheme = SrcInitOutputData%CouplingScheme DstInitOutputData%UseHSSBrake = SrcInitOutputData%UseHSSBrake if (allocated(SrcInitOutputData%LinNames_y)) then @@ -1091,6 +1177,7 @@ subroutine SrvD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitOutputData%Vars) if (allocated(InitOutputData%LinNames_y)) then deallocate(InitOutputData%LinNames_y) end if @@ -1121,10 +1208,18 @@ subroutine SrvD_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(SrvD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackInitOutput' + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if call RegPack(RF, InData%CouplingScheme) call RegPack(RF, InData%UseHSSBrake) call RegPackAlloc(RF, InData%LinNames_y) @@ -1145,10 +1240,30 @@ subroutine SrvD_UnPackInitOutput(RF, OutData) integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if call RegUnpack(RF, OutData%CouplingScheme); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%UseHSSBrake); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return @@ -3792,398 +3907,719 @@ subroutine SrvD_UnPackModuleMapType(RF, OutData) end if end subroutine -subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(SrvD_MiscVarType), intent(inout) :: SrcMiscData - type(SrvD_MiscVarType), intent(inout) :: DstMiscData +subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_ParameterType), intent(in) :: SrcParamData + type(SrvD_ParameterType), intent(inout) :: DstParamData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SrvD_CopyMisc' + character(*), parameter :: RoutineName = 'SrvD_CopyParam' ErrStat = ErrID_None ErrMsg = '' - DstMiscData%LastTimeCalled = SrcMiscData%LastTimeCalled - call SrvD_CopyBladedDLLType(SrcMiscData%dll_data, DstMiscData%dll_data, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - DstMiscData%FirstWarn = SrcMiscData%FirstWarn - DstMiscData%LastTimeFiltered = SrcMiscData%LastTimeFiltered - if (allocated(SrcMiscData%xd_BlPitchFilter)) then - LB(1:1) = lbound(SrcMiscData%xd_BlPitchFilter) - UB(1:1) = ubound(SrcMiscData%xd_BlPitchFilter) - if (.not. allocated(DstMiscData%xd_BlPitchFilter)) then - allocate(DstMiscData%xd_BlPitchFilter(LB(1):UB(1)), stat=ErrStat2) + DstParamData%DT = SrcParamData%DT + DstParamData%HSSBrDT = SrcParamData%HSSBrDT + DstParamData%HSSBrTqF = SrcParamData%HSSBrTqF + DstParamData%SIG_POSl = SrcParamData%SIG_POSl + DstParamData%SIG_POTq = SrcParamData%SIG_POTq + DstParamData%SIG_SlPc = SrcParamData%SIG_SlPc + DstParamData%SIG_Slop = SrcParamData%SIG_Slop + DstParamData%SIG_SySp = SrcParamData%SIG_SySp + DstParamData%TEC_A0 = SrcParamData%TEC_A0 + DstParamData%TEC_C0 = SrcParamData%TEC_C0 + DstParamData%TEC_C1 = SrcParamData%TEC_C1 + DstParamData%TEC_C2 = SrcParamData%TEC_C2 + DstParamData%TEC_K2 = SrcParamData%TEC_K2 + DstParamData%TEC_MR = SrcParamData%TEC_MR + DstParamData%TEC_Re1 = SrcParamData%TEC_Re1 + DstParamData%TEC_RLR = SrcParamData%TEC_RLR + DstParamData%TEC_RRes = SrcParamData%TEC_RRes + DstParamData%TEC_SRes = SrcParamData%TEC_SRes + DstParamData%TEC_SySp = SrcParamData%TEC_SySp + DstParamData%TEC_V1a = SrcParamData%TEC_V1a + DstParamData%TEC_VLL = SrcParamData%TEC_VLL + DstParamData%TEC_Xe1 = SrcParamData%TEC_Xe1 + DstParamData%GenEff = SrcParamData%GenEff + if (allocated(SrcParamData%BlPitchInit)) then + LB(1:1) = lbound(SrcParamData%BlPitchInit) + UB(1:1) = ubound(SrcParamData%BlPitchInit) + if (.not. allocated(DstParamData%BlPitchInit)) then + allocate(DstParamData%BlPitchInit(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%xd_BlPitchFilter.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlPitchInit.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%xd_BlPitchFilter = SrcMiscData%xd_BlPitchFilter + DstParamData%BlPitchInit = SrcParamData%BlPitchInit end if - if (allocated(SrcMiscData%BStC)) then - LB(1:1) = lbound(SrcMiscData%BStC) - UB(1:1) = ubound(SrcMiscData%BStC) - if (.not. allocated(DstMiscData%BStC)) then - allocate(DstMiscData%BStC(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%BlPitchF)) then + LB(1:1) = lbound(SrcParamData%BlPitchF) + UB(1:1) = ubound(SrcParamData%BlPitchF) + if (.not. allocated(DstParamData%BlPitchF)) then + allocate(DstParamData%BlPitchF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlPitchF.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call StC_CopyMisc(SrcMiscData%BStC(i1), DstMiscData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%BlPitchF = SrcParamData%BlPitchF end if - if (allocated(SrcMiscData%NStC)) then - LB(1:1) = lbound(SrcMiscData%NStC) - UB(1:1) = ubound(SrcMiscData%NStC) - if (.not. allocated(DstMiscData%NStC)) then - allocate(DstMiscData%NStC(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%PitManRat)) then + LB(1:1) = lbound(SrcParamData%PitManRat) + UB(1:1) = ubound(SrcParamData%PitManRat) + if (.not. allocated(DstParamData%PitManRat)) then + allocate(DstParamData%PitManRat(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%NStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PitManRat.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call StC_CopyMisc(SrcMiscData%NStC(i1), DstMiscData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%PitManRat = SrcParamData%PitManRat end if - if (allocated(SrcMiscData%TStC)) then - LB(1:1) = lbound(SrcMiscData%TStC) - UB(1:1) = ubound(SrcMiscData%TStC) - if (.not. allocated(DstMiscData%TStC)) then - allocate(DstMiscData%TStC(LB(1):UB(1)), stat=ErrStat2) + DstParamData%YawManRat = SrcParamData%YawManRat + DstParamData%NacYawF = SrcParamData%NacYawF + DstParamData%SpdGenOn = SrcParamData%SpdGenOn + DstParamData%THSSBrDp = SrcParamData%THSSBrDp + DstParamData%THSSBrFl = SrcParamData%THSSBrFl + DstParamData%TimGenOf = SrcParamData%TimGenOf + DstParamData%TimGenOn = SrcParamData%TimGenOn + DstParamData%TPCOn = SrcParamData%TPCOn + if (allocated(SrcParamData%TPitManS)) then + LB(1:1) = lbound(SrcParamData%TPitManS) + UB(1:1) = ubound(SrcParamData%TPitManS) + if (.not. allocated(DstParamData%TPitManS)) then + allocate(DstParamData%TPitManS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TPitManS.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call StC_CopyMisc(SrcMiscData%TStC(i1), DstMiscData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%TPitManS = SrcParamData%TPitManS end if - if (allocated(SrcMiscData%SStC)) then - LB(1:1) = lbound(SrcMiscData%SStC) - UB(1:1) = ubound(SrcMiscData%SStC) - if (.not. allocated(DstMiscData%SStC)) then - allocate(DstMiscData%SStC(LB(1):UB(1)), stat=ErrStat2) + DstParamData%TYawManS = SrcParamData%TYawManS + DstParamData%TYCOn = SrcParamData%TYCOn + DstParamData%VS_RtGnSp = SrcParamData%VS_RtGnSp + DstParamData%VS_RtTq = SrcParamData%VS_RtTq + DstParamData%VS_Slope = SrcParamData%VS_Slope + DstParamData%VS_SlPc = SrcParamData%VS_SlPc + DstParamData%VS_SySp = SrcParamData%VS_SySp + DstParamData%VS_TrGnSp = SrcParamData%VS_TrGnSp + DstParamData%YawPosCom = SrcParamData%YawPosCom + DstParamData%YawRateCom = SrcParamData%YawRateCom + DstParamData%GenModel = SrcParamData%GenModel + DstParamData%HSSBrMode = SrcParamData%HSSBrMode + DstParamData%PCMode = SrcParamData%PCMode + DstParamData%VSContrl = SrcParamData%VSContrl + DstParamData%YCMode = SrcParamData%YCMode + DstParamData%GenTiStp = SrcParamData%GenTiStp + DstParamData%GenTiStr = SrcParamData%GenTiStr + DstParamData%VS_Rgn2K = SrcParamData%VS_Rgn2K + DstParamData%YawNeut = SrcParamData%YawNeut + DstParamData%YawSpr = SrcParamData%YawSpr + DstParamData%YawDamp = SrcParamData%YawDamp + DstParamData%TpBrDT = SrcParamData%TpBrDT + if (allocated(SrcParamData%TBDepISp)) then + LB(1:1) = lbound(SrcParamData%TBDepISp) + UB(1:1) = ubound(SrcParamData%TBDepISp) + if (.not. allocated(DstParamData%TBDepISp)) then + allocate(DstParamData%TBDepISp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TBDepISp.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call StC_CopyMisc(SrcMiscData%SStC(i1), DstMiscData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%TBDepISp = SrcParamData%TBDepISp end if - if (allocated(SrcMiscData%u_BStC)) then - LB(1:2) = lbound(SrcMiscData%u_BStC) - UB(1:2) = ubound(SrcMiscData%u_BStC) - if (.not. allocated(DstMiscData%u_BStC)) then - allocate(DstMiscData%u_BStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + DstParamData%TBDrConN = SrcParamData%TBDrConN + DstParamData%TBDrConD = SrcParamData%TBDrConD + DstParamData%NumBl = SrcParamData%NumBl + DstParamData%NumBStC = SrcParamData%NumBStC + DstParamData%NumNStC = SrcParamData%NumNStC + DstParamData%NumTStC = SrcParamData%NumTStC + DstParamData%NumSStC = SrcParamData%NumSStC + DstParamData%AfCmode = SrcParamData%AfCmode + DstParamData%AfC_Mean = SrcParamData%AfC_Mean + DstParamData%AfC_Amp = SrcParamData%AfC_Amp + DstParamData%AfC_Phase = SrcParamData%AfC_Phase + DstParamData%CCmode = SrcParamData%CCmode + DstParamData%StCCmode = SrcParamData%StCCmode + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NumOuts_DLL = SrcParamData%NumOuts_DLL + DstParamData%RootName = SrcParamData%RootName + DstParamData%PriPath = SrcParamData%PriPath + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_BStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) return end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_CopyInput(SrcMiscData%u_BStC(i1,i2), DstMiscData%u_BStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcMiscData%u_NStC)) then - LB(1:2) = lbound(SrcMiscData%u_NStC) - UB(1:2) = ubound(SrcMiscData%u_NStC) - if (.not. allocated(DstMiscData%u_NStC)) then - allocate(DstMiscData%u_NStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + DstParamData%Delim = SrcParamData%Delim + DstParamData%UseBladedInterface = SrcParamData%UseBladedInterface + DstParamData%UseLegacyInterface = SrcParamData%UseLegacyInterface + DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt + DstParamData%DLL_Ramp = SrcParamData%DLL_Ramp + DstParamData%BlAlpha = SrcParamData%BlAlpha + DstParamData%DLL_n = SrcParamData%DLL_n + DstParamData%avcOUTNAME_LEN = SrcParamData%avcOUTNAME_LEN + DstParamData%NacYaw_North = SrcParamData%NacYaw_North + DstParamData%AvgWindSpeed = SrcParamData%AvgWindSpeed + DstParamData%AirDens = SrcParamData%AirDens + DstParamData%TrimCase = SrcParamData%TrimCase + DstParamData%TrimGain = SrcParamData%TrimGain + DstParamData%RotSpeedRef = SrcParamData%RotSpeedRef + if (allocated(SrcParamData%BStC)) then + LB(1:1) = lbound(SrcParamData%BStC) + UB(1:1) = ubound(SrcParamData%BStC) + if (.not. allocated(DstParamData%BStC)) then + allocate(DstParamData%BStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_NStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BStC.', ErrStat, ErrMsg, RoutineName) return end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_CopyInput(SrcMiscData%u_NStC(i1,i2), DstMiscData%u_NStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + do i1 = LB(1), UB(1) + call StC_CopyParam(SrcParamData%BStC(i1), DstParamData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcMiscData%u_TStC)) then - LB(1:2) = lbound(SrcMiscData%u_TStC) - UB(1:2) = ubound(SrcMiscData%u_TStC) - if (.not. allocated(DstMiscData%u_TStC)) then - allocate(DstMiscData%u_TStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%NStC)) then + LB(1:1) = lbound(SrcParamData%NStC) + UB(1:1) = ubound(SrcParamData%NStC) + if (.not. allocated(DstParamData%NStC)) then + allocate(DstParamData%NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_TStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NStC.', ErrStat, ErrMsg, RoutineName) return end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_CopyInput(SrcMiscData%u_TStC(i1,i2), DstMiscData%u_TStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + do i1 = LB(1), UB(1) + call StC_CopyParam(SrcParamData%NStC(i1), DstParamData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcMiscData%u_SStC)) then - LB(1:2) = lbound(SrcMiscData%u_SStC) - UB(1:2) = ubound(SrcMiscData%u_SStC) - if (.not. allocated(DstMiscData%u_SStC)) then - allocate(DstMiscData%u_SStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%TStC)) then + LB(1:1) = lbound(SrcParamData%TStC) + UB(1:1) = ubound(SrcParamData%TStC) + if (.not. allocated(DstParamData%TStC)) then + allocate(DstParamData%TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_SStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TStC.', ErrStat, ErrMsg, RoutineName) return end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_CopyInput(SrcMiscData%u_SStC(i1,i2), DstMiscData%u_SStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + do i1 = LB(1), UB(1) + call StC_CopyParam(SrcParamData%TStC(i1), DstParamData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcMiscData%y_BStC)) then - LB(1:1) = lbound(SrcMiscData%y_BStC) - UB(1:1) = ubound(SrcMiscData%y_BStC) - if (.not. allocated(DstMiscData%y_BStC)) then - allocate(DstMiscData%y_BStC(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%SStC)) then + LB(1:1) = lbound(SrcParamData%SStC) + UB(1:1) = ubound(SrcParamData%SStC) + if (.not. allocated(DstParamData%SStC)) then + allocate(DstParamData%SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_BStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SStC.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call StC_CopyOutput(SrcMiscData%y_BStC(i1), DstMiscData%y_BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call StC_CopyParam(SrcParamData%SStC(i1), DstParamData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcMiscData%y_NStC)) then - LB(1:1) = lbound(SrcMiscData%y_NStC) - UB(1:1) = ubound(SrcMiscData%y_NStC) - if (.not. allocated(DstMiscData%y_NStC)) then - allocate(DstMiscData%y_NStC(LB(1):UB(1)), stat=ErrStat2) + DstParamData%InterpOrder = SrcParamData%InterpOrder + DstParamData%EXavrSWAP = SrcParamData%EXavrSWAP + DstParamData%NumCableControl = SrcParamData%NumCableControl + DstParamData%NumStC_Control = SrcParamData%NumStC_Control + if (allocated(SrcParamData%StCMeasNumPerChan)) then + LB(1:1) = lbound(SrcParamData%StCMeasNumPerChan) + UB(1:1) = ubound(SrcParamData%StCMeasNumPerChan) + if (.not. allocated(DstParamData%StCMeasNumPerChan)) then + allocate(DstParamData%StCMeasNumPerChan(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_NStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StCMeasNumPerChan.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call StC_CopyOutput(SrcMiscData%y_NStC(i1), DstMiscData%y_NStC(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%StCMeasNumPerChan = SrcParamData%StCMeasNumPerChan end if - if (allocated(SrcMiscData%y_TStC)) then - LB(1:1) = lbound(SrcMiscData%y_TStC) - UB(1:1) = ubound(SrcMiscData%y_TStC) - if (.not. allocated(DstMiscData%y_TStC)) then - allocate(DstMiscData%y_TStC(LB(1):UB(1)), stat=ErrStat2) + DstParamData%UseSC = SrcParamData%UseSC + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_TStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call StC_CopyOutput(SrcMiscData%y_TStC(i1), DstMiscData%y_TStC(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx end if - if (allocated(SrcMiscData%y_SStC)) then - LB(1:1) = lbound(SrcMiscData%y_SStC) - UB(1:1) = ubound(SrcMiscData%y_SStC) - if (.not. allocated(DstMiscData%y_SStC)) then - allocate(DstMiscData%y_SStC(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%Jac_x_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_x_indx) + UB(1:2) = ubound(SrcParamData%Jac_x_indx) + if (.not. allocated(DstParamData%Jac_x_indx)) then + allocate(DstParamData%Jac_x_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_SStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_x_indx.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call StC_CopyOutput(SrcMiscData%y_SStC(i1), DstMiscData%y_SStC(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - call SrvD_CopyModuleMapType(SrcMiscData%SrvD_MeshMap, DstMiscData%SrvD_MeshMap, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - DstMiscData%PrevTstepNcall = SrcMiscData%PrevTstepNcall -end subroutine - -subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(SrvD_MiscVarType), intent(inout) :: MiscData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SrvD_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = '' - call SrvD_DestroyBladedDLLType(MiscData%dll_data, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(MiscData%xd_BlPitchFilter)) then - deallocate(MiscData%xd_BlPitchFilter) + DstParamData%Jac_x_indx = SrcParamData%Jac_x_indx end if - if (allocated(MiscData%BStC)) then - LB(1:1) = lbound(MiscData%BStC) - UB(1:1) = ubound(MiscData%BStC) - do i1 = LB(1), UB(1) - call StC_DestroyMisc(MiscData%BStC(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%BStC) + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%du = SrcParamData%du end if - if (allocated(MiscData%NStC)) then - LB(1:1) = lbound(MiscData%NStC) - UB(1:1) = ubound(MiscData%NStC) - do i1 = LB(1), UB(1) - call StC_DestroyMisc(MiscData%NStC(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%NStC) + if (allocated(SrcParamData%dx)) then + LB(1:1) = lbound(SrcParamData%dx) + UB(1:1) = ubound(SrcParamData%dx) + if (.not. allocated(DstParamData%dx)) then + allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dx = SrcParamData%dx end if - if (allocated(MiscData%TStC)) then - LB(1:1) = lbound(MiscData%TStC) - UB(1:1) = ubound(MiscData%TStC) - do i1 = LB(1), UB(1) - call StC_DestroyMisc(MiscData%TStC(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%TStC) + DstParamData%Jac_nu = SrcParamData%Jac_nu + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%Jac_nx = SrcParamData%Jac_nx + if (allocated(SrcParamData%Jac_Idx_BStC_u)) then + LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_u) + UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_u) + if (.not. allocated(DstParamData%Jac_Idx_BStC_u)) then + allocate(DstParamData%Jac_Idx_BStC_u(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_BStC_u = SrcParamData%Jac_Idx_BStC_u end if - if (allocated(MiscData%SStC)) then - LB(1:1) = lbound(MiscData%SStC) - UB(1:1) = ubound(MiscData%SStC) - do i1 = LB(1), UB(1) - call StC_DestroyMisc(MiscData%SStC(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%SStC) + if (allocated(SrcParamData%Jac_Idx_NStC_u)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_u) + UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_u) + if (.not. allocated(DstParamData%Jac_Idx_NStC_u)) then + allocate(DstParamData%Jac_Idx_NStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_NStC_u = SrcParamData%Jac_Idx_NStC_u end if - if (allocated(MiscData%u_BStC)) then - LB(1:2) = lbound(MiscData%u_BStC) - UB(1:2) = ubound(MiscData%u_BStC) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_DestroyInput(MiscData%u_BStC(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(MiscData%u_BStC) + if (allocated(SrcParamData%Jac_Idx_TStC_u)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_u) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_u) + if (.not. allocated(DstParamData%Jac_Idx_TStC_u)) then + allocate(DstParamData%Jac_Idx_TStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_TStC_u = SrcParamData%Jac_Idx_TStC_u end if - if (allocated(MiscData%u_NStC)) then - LB(1:2) = lbound(MiscData%u_NStC) - UB(1:2) = ubound(MiscData%u_NStC) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_DestroyInput(MiscData%u_NStC(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(MiscData%u_NStC) + if (allocated(SrcParamData%Jac_Idx_SStC_u)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_u) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_u) + if (.not. allocated(DstParamData%Jac_Idx_SStC_u)) then + allocate(DstParamData%Jac_Idx_SStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_SStC_u = SrcParamData%Jac_Idx_SStC_u end if - if (allocated(MiscData%u_TStC)) then - LB(1:2) = lbound(MiscData%u_TStC) - UB(1:2) = ubound(MiscData%u_TStC) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_DestroyInput(MiscData%u_TStC(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(MiscData%u_TStC) + if (allocated(SrcParamData%Jac_Idx_BStC_x)) then + LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_x) + UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_x) + if (.not. allocated(DstParamData%Jac_Idx_BStC_x)) then + allocate(DstParamData%Jac_Idx_BStC_x(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_BStC_x = SrcParamData%Jac_Idx_BStC_x end if - if (allocated(MiscData%u_SStC)) then - LB(1:2) = lbound(MiscData%u_SStC) - UB(1:2) = ubound(MiscData%u_SStC) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_DestroyInput(MiscData%u_SStC(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - end do - deallocate(MiscData%u_SStC) + if (allocated(SrcParamData%Jac_Idx_NStC_x)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_x) + UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_x) + if (.not. allocated(DstParamData%Jac_Idx_NStC_x)) then + allocate(DstParamData%Jac_Idx_NStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_NStC_x = SrcParamData%Jac_Idx_NStC_x end if - if (allocated(MiscData%y_BStC)) then - LB(1:1) = lbound(MiscData%y_BStC) - UB(1:1) = ubound(MiscData%y_BStC) + if (allocated(SrcParamData%Jac_Idx_TStC_x)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_x) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_x) + if (.not. allocated(DstParamData%Jac_Idx_TStC_x)) then + allocate(DstParamData%Jac_Idx_TStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_TStC_x = SrcParamData%Jac_Idx_TStC_x + end if + if (allocated(SrcParamData%Jac_Idx_SStC_x)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_x) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_x) + if (.not. allocated(DstParamData%Jac_Idx_SStC_x)) then + allocate(DstParamData%Jac_Idx_SStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_SStC_x = SrcParamData%Jac_Idx_SStC_x + end if + if (allocated(SrcParamData%Jac_Idx_BStC_y)) then + LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_y) + UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_y) + if (.not. allocated(DstParamData%Jac_Idx_BStC_y)) then + allocate(DstParamData%Jac_Idx_BStC_y(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_BStC_y = SrcParamData%Jac_Idx_BStC_y + end if + if (allocated(SrcParamData%Jac_Idx_NStC_y)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_y) + UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_y) + if (.not. allocated(DstParamData%Jac_Idx_NStC_y)) then + allocate(DstParamData%Jac_Idx_NStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_NStC_y = SrcParamData%Jac_Idx_NStC_y + end if + if (allocated(SrcParamData%Jac_Idx_TStC_y)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_y) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_y) + if (.not. allocated(DstParamData%Jac_Idx_TStC_y)) then + allocate(DstParamData%Jac_Idx_TStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_TStC_y = SrcParamData%Jac_Idx_TStC_y + end if + if (allocated(SrcParamData%Jac_Idx_SStC_y)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_y) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_y) + if (.not. allocated(DstParamData%Jac_Idx_SStC_y)) then + allocate(DstParamData%Jac_Idx_SStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_SStC_y = SrcParamData%Jac_Idx_SStC_y + end if + DstParamData%SensorType = SrcParamData%SensorType + DstParamData%NumBeam = SrcParamData%NumBeam + DstParamData%NumPulseGate = SrcParamData%NumPulseGate + DstParamData%PulseSpacing = SrcParamData%PulseSpacing + DstParamData%URefLid = SrcParamData%URefLid + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if +end subroutine + +subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SrvD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%BlPitchInit)) then + deallocate(ParamData%BlPitchInit) + end if + if (allocated(ParamData%BlPitchF)) then + deallocate(ParamData%BlPitchF) + end if + if (allocated(ParamData%PitManRat)) then + deallocate(ParamData%PitManRat) + end if + if (allocated(ParamData%TPitManS)) then + deallocate(ParamData%TPitManS) + end if + if (allocated(ParamData%TBDepISp)) then + deallocate(ParamData%TBDepISp) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) do i1 = LB(1), UB(1) - call StC_DestroyOutput(MiscData%y_BStC(i1), ErrStat2, ErrMsg2) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%y_BStC) + deallocate(ParamData%OutParam) end if - if (allocated(MiscData%y_NStC)) then - LB(1:1) = lbound(MiscData%y_NStC) - UB(1:1) = ubound(MiscData%y_NStC) + call FreeDynamicLib( ParamData%DLL_Trgt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ParamData%BStC)) then + LB(1:1) = lbound(ParamData%BStC) + UB(1:1) = ubound(ParamData%BStC) do i1 = LB(1), UB(1) - call StC_DestroyOutput(MiscData%y_NStC(i1), ErrStat2, ErrMsg2) + call StC_DestroyParam(ParamData%BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%y_NStC) + deallocate(ParamData%BStC) end if - if (allocated(MiscData%y_TStC)) then - LB(1:1) = lbound(MiscData%y_TStC) - UB(1:1) = ubound(MiscData%y_TStC) + if (allocated(ParamData%NStC)) then + LB(1:1) = lbound(ParamData%NStC) + UB(1:1) = ubound(ParamData%NStC) do i1 = LB(1), UB(1) - call StC_DestroyOutput(MiscData%y_TStC(i1), ErrStat2, ErrMsg2) + call StC_DestroyParam(ParamData%NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%y_TStC) + deallocate(ParamData%NStC) end if - if (allocated(MiscData%y_SStC)) then - LB(1:1) = lbound(MiscData%y_SStC) - UB(1:1) = ubound(MiscData%y_SStC) + if (allocated(ParamData%TStC)) then + LB(1:1) = lbound(ParamData%TStC) + UB(1:1) = ubound(ParamData%TStC) do i1 = LB(1), UB(1) - call StC_DestroyOutput(MiscData%y_SStC(i1), ErrStat2, ErrMsg2) + call StC_DestroyParam(ParamData%TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%y_SStC) + deallocate(ParamData%TStC) end if - call SrvD_DestroyModuleMapType(MiscData%SrvD_MeshMap, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -end subroutine - -subroutine SrvD_PackMisc(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SrvD_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SrvD_PackMisc' - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%LastTimeCalled) - call SrvD_PackBladedDLLType(RF, InData%dll_data) - call RegPack(RF, InData%FirstWarn) - call RegPack(RF, InData%LastTimeFiltered) - call RegPackAlloc(RF, InData%xd_BlPitchFilter) - call RegPack(RF, allocated(InData%BStC)) - if (allocated(InData%BStC)) then - call RegPackBounds(RF, 1, lbound(InData%BStC), ubound(InData%BStC)) - LB(1:1) = lbound(InData%BStC) - UB(1:1) = ubound(InData%BStC) + if (allocated(ParamData%SStC)) then + LB(1:1) = lbound(ParamData%SStC) + UB(1:1) = ubound(ParamData%SStC) do i1 = LB(1), UB(1) - call StC_PackMisc(RF, InData%BStC(i1)) + call StC_DestroyParam(ParamData%SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%SStC) + end if + if (allocated(ParamData%StCMeasNumPerChan)) then + deallocate(ParamData%StCMeasNumPerChan) + end if + if (allocated(ParamData%Jac_u_indx)) then + deallocate(ParamData%Jac_u_indx) + end if + if (allocated(ParamData%Jac_x_indx)) then + deallocate(ParamData%Jac_x_indx) + end if + if (allocated(ParamData%du)) then + deallocate(ParamData%du) + end if + if (allocated(ParamData%dx)) then + deallocate(ParamData%dx) + end if + if (allocated(ParamData%Jac_Idx_BStC_u)) then + deallocate(ParamData%Jac_Idx_BStC_u) + end if + if (allocated(ParamData%Jac_Idx_NStC_u)) then + deallocate(ParamData%Jac_Idx_NStC_u) + end if + if (allocated(ParamData%Jac_Idx_TStC_u)) then + deallocate(ParamData%Jac_Idx_TStC_u) + end if + if (allocated(ParamData%Jac_Idx_SStC_u)) then + deallocate(ParamData%Jac_Idx_SStC_u) + end if + if (allocated(ParamData%Jac_Idx_BStC_x)) then + deallocate(ParamData%Jac_Idx_BStC_x) + end if + if (allocated(ParamData%Jac_Idx_NStC_x)) then + deallocate(ParamData%Jac_Idx_NStC_x) + end if + if (allocated(ParamData%Jac_Idx_TStC_x)) then + deallocate(ParamData%Jac_Idx_TStC_x) + end if + if (allocated(ParamData%Jac_Idx_SStC_x)) then + deallocate(ParamData%Jac_Idx_SStC_x) + end if + if (allocated(ParamData%Jac_Idx_BStC_y)) then + deallocate(ParamData%Jac_Idx_BStC_y) + end if + if (allocated(ParamData%Jac_Idx_NStC_y)) then + deallocate(ParamData%Jac_Idx_NStC_y) + end if + if (allocated(ParamData%Jac_Idx_TStC_y)) then + deallocate(ParamData%Jac_Idx_TStC_y) + end if + if (allocated(ParamData%Jac_Idx_SStC_y)) then + deallocate(ParamData%Jac_Idx_SStC_y) + end if + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if +end subroutine + +subroutine SrvD_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SrvD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackParam' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%HSSBrDT) + call RegPack(RF, InData%HSSBrTqF) + call RegPack(RF, InData%SIG_POSl) + call RegPack(RF, InData%SIG_POTq) + call RegPack(RF, InData%SIG_SlPc) + call RegPack(RF, InData%SIG_Slop) + call RegPack(RF, InData%SIG_SySp) + call RegPack(RF, InData%TEC_A0) + call RegPack(RF, InData%TEC_C0) + call RegPack(RF, InData%TEC_C1) + call RegPack(RF, InData%TEC_C2) + call RegPack(RF, InData%TEC_K2) + call RegPack(RF, InData%TEC_MR) + call RegPack(RF, InData%TEC_Re1) + call RegPack(RF, InData%TEC_RLR) + call RegPack(RF, InData%TEC_RRes) + call RegPack(RF, InData%TEC_SRes) + call RegPack(RF, InData%TEC_SySp) + call RegPack(RF, InData%TEC_V1a) + call RegPack(RF, InData%TEC_VLL) + call RegPack(RF, InData%TEC_Xe1) + call RegPack(RF, InData%GenEff) + call RegPackAlloc(RF, InData%BlPitchInit) + call RegPackAlloc(RF, InData%BlPitchF) + call RegPackAlloc(RF, InData%PitManRat) + call RegPack(RF, InData%YawManRat) + call RegPack(RF, InData%NacYawF) + call RegPack(RF, InData%SpdGenOn) + call RegPack(RF, InData%THSSBrDp) + call RegPack(RF, InData%THSSBrFl) + call RegPack(RF, InData%TimGenOf) + call RegPack(RF, InData%TimGenOn) + call RegPack(RF, InData%TPCOn) + call RegPackAlloc(RF, InData%TPitManS) + call RegPack(RF, InData%TYawManS) + call RegPack(RF, InData%TYCOn) + call RegPack(RF, InData%VS_RtGnSp) + call RegPack(RF, InData%VS_RtTq) + call RegPack(RF, InData%VS_Slope) + call RegPack(RF, InData%VS_SlPc) + call RegPack(RF, InData%VS_SySp) + call RegPack(RF, InData%VS_TrGnSp) + call RegPack(RF, InData%YawPosCom) + call RegPack(RF, InData%YawRateCom) + call RegPack(RF, InData%GenModel) + call RegPack(RF, InData%HSSBrMode) + call RegPack(RF, InData%PCMode) + call RegPack(RF, InData%VSContrl) + call RegPack(RF, InData%YCMode) + call RegPack(RF, InData%GenTiStp) + call RegPack(RF, InData%GenTiStr) + call RegPack(RF, InData%VS_Rgn2K) + call RegPack(RF, InData%YawNeut) + call RegPack(RF, InData%YawSpr) + call RegPack(RF, InData%YawDamp) + call RegPack(RF, InData%TpBrDT) + call RegPackAlloc(RF, InData%TBDepISp) + call RegPack(RF, InData%TBDrConN) + call RegPack(RF, InData%TBDrConD) + call RegPack(RF, InData%NumBl) + call RegPack(RF, InData%NumBStC) + call RegPack(RF, InData%NumNStC) + call RegPack(RF, InData%NumTStC) + call RegPack(RF, InData%NumSStC) + call RegPack(RF, InData%AfCmode) + call RegPack(RF, InData%AfC_Mean) + call RegPack(RF, InData%AfC_Amp) + call RegPack(RF, InData%AfC_Phase) + call RegPack(RF, InData%CCmode) + call RegPack(RF, InData%StCCmode) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%NumOuts_DLL) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%PriPath) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) + end do + end if + call RegPack(RF, InData%Delim) + call RegPack(RF, InData%UseBladedInterface) + call RegPack(RF, InData%UseLegacyInterface) + call DLLTypePack(RF, InData%DLL_Trgt) + call RegPack(RF, InData%DLL_Ramp) + call RegPack(RF, InData%BlAlpha) + call RegPack(RF, InData%DLL_n) + call RegPack(RF, InData%avcOUTNAME_LEN) + call RegPack(RF, InData%NacYaw_North) + call RegPack(RF, InData%AvgWindSpeed) + call RegPack(RF, InData%AirDens) + call RegPack(RF, InData%TrimCase) + call RegPack(RF, InData%TrimGain) + call RegPack(RF, InData%RotSpeedRef) + call RegPack(RF, allocated(InData%BStC)) + if (allocated(InData%BStC)) then + call RegPackBounds(RF, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) + do i1 = LB(1), UB(1) + call StC_PackParam(RF, InData%BStC(i1)) end do end if call RegPack(RF, allocated(InData%NStC)) @@ -4192,7 +4628,7 @@ subroutine SrvD_PackMisc(RF, Indata) LB(1:1) = lbound(InData%NStC) UB(1:1) = ubound(InData%NStC) do i1 = LB(1), UB(1) - call StC_PackMisc(RF, InData%NStC(i1)) + call StC_PackParam(RF, InData%NStC(i1)) end do end if call RegPack(RF, allocated(InData%TStC)) @@ -4201,7 +4637,7 @@ subroutine SrvD_PackMisc(RF, Indata) LB(1:1) = lbound(InData%TStC) UB(1:1) = ubound(InData%TStC) do i1 = LB(1), UB(1) - call StC_PackMisc(RF, InData%TStC(i1)) + call StC_PackParam(RF, InData%TStC(i1)) end do end if call RegPack(RF, allocated(InData%SStC)) @@ -4210,108 +4646,162 @@ subroutine SrvD_PackMisc(RF, Indata) LB(1:1) = lbound(InData%SStC) UB(1:1) = ubound(InData%SStC) do i1 = LB(1), UB(1) - call StC_PackMisc(RF, InData%SStC(i1)) - end do - end if - call RegPack(RF, allocated(InData%u_BStC)) - if (allocated(InData%u_BStC)) then - call RegPackBounds(RF, 2, lbound(InData%u_BStC), ubound(InData%u_BStC)) - LB(1:2) = lbound(InData%u_BStC) - UB(1:2) = ubound(InData%u_BStC) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_PackInput(RF, InData%u_BStC(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%u_NStC)) - if (allocated(InData%u_NStC)) then - call RegPackBounds(RF, 2, lbound(InData%u_NStC), ubound(InData%u_NStC)) - LB(1:2) = lbound(InData%u_NStC) - UB(1:2) = ubound(InData%u_NStC) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_PackInput(RF, InData%u_NStC(i1,i2)) - end do - end do - end if - call RegPack(RF, allocated(InData%u_TStC)) - if (allocated(InData%u_TStC)) then - call RegPackBounds(RF, 2, lbound(InData%u_TStC), ubound(InData%u_TStC)) - LB(1:2) = lbound(InData%u_TStC) - UB(1:2) = ubound(InData%u_TStC) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_PackInput(RF, InData%u_TStC(i1,i2)) - end do + call StC_PackParam(RF, InData%SStC(i1)) end do end if - call RegPack(RF, allocated(InData%u_SStC)) - if (allocated(InData%u_SStC)) then - call RegPackBounds(RF, 2, lbound(InData%u_SStC), ubound(InData%u_SStC)) - LB(1:2) = lbound(InData%u_SStC) - UB(1:2) = ubound(InData%u_SStC) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_PackInput(RF, InData%u_SStC(i1,i2)) - end do - end do + call RegPack(RF, InData%InterpOrder) + call RegPack(RF, InData%EXavrSWAP) + call RegPack(RF, InData%NumCableControl) + call RegPack(RF, InData%NumStC_Control) + call RegPackAlloc(RF, InData%StCMeasNumPerChan) + call RegPack(RF, InData%UseSC) + call RegPackAlloc(RF, InData%Jac_u_indx) + call RegPackAlloc(RF, InData%Jac_x_indx) + call RegPackAlloc(RF, InData%du) + call RegPackAlloc(RF, InData%dx) + call RegPack(RF, InData%Jac_nu) + call RegPack(RF, InData%Jac_ny) + call RegPack(RF, InData%Jac_nx) + call RegPackAlloc(RF, InData%Jac_Idx_BStC_u) + call RegPackAlloc(RF, InData%Jac_Idx_NStC_u) + call RegPackAlloc(RF, InData%Jac_Idx_TStC_u) + call RegPackAlloc(RF, InData%Jac_Idx_SStC_u) + call RegPackAlloc(RF, InData%Jac_Idx_BStC_x) + call RegPackAlloc(RF, InData%Jac_Idx_NStC_x) + call RegPackAlloc(RF, InData%Jac_Idx_TStC_x) + call RegPackAlloc(RF, InData%Jac_Idx_SStC_x) + call RegPackAlloc(RF, InData%Jac_Idx_BStC_y) + call RegPackAlloc(RF, InData%Jac_Idx_NStC_y) + call RegPackAlloc(RF, InData%Jac_Idx_TStC_y) + call RegPackAlloc(RF, InData%Jac_Idx_SStC_y) + call RegPack(RF, InData%SensorType) + call RegPack(RF, InData%NumBeam) + call RegPack(RF, InData%NumPulseGate) + call RegPack(RF, InData%PulseSpacing) + call RegPack(RF, InData%URefLid) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if end if - call RegPack(RF, allocated(InData%y_BStC)) - if (allocated(InData%y_BStC)) then - call RegPackBounds(RF, 1, lbound(InData%y_BStC), ubound(InData%y_BStC)) - LB(1:1) = lbound(InData%y_BStC) - UB(1:1) = ubound(InData%y_BStC) - do i1 = LB(1), UB(1) - call StC_PackOutput(RF, InData%y_BStC(i1)) - end do - end if - call RegPack(RF, allocated(InData%y_NStC)) - if (allocated(InData%y_NStC)) then - call RegPackBounds(RF, 1, lbound(InData%y_NStC), ubound(InData%y_NStC)) - LB(1:1) = lbound(InData%y_NStC) - UB(1:1) = ubound(InData%y_NStC) - do i1 = LB(1), UB(1) - call StC_PackOutput(RF, InData%y_NStC(i1)) - end do - end if - call RegPack(RF, allocated(InData%y_TStC)) - if (allocated(InData%y_TStC)) then - call RegPackBounds(RF, 1, lbound(InData%y_TStC), ubound(InData%y_TStC)) - LB(1:1) = lbound(InData%y_TStC) - UB(1:1) = ubound(InData%y_TStC) - do i1 = LB(1), UB(1) - call StC_PackOutput(RF, InData%y_TStC(i1)) - end do - end if - call RegPack(RF, allocated(InData%y_SStC)) - if (allocated(InData%y_SStC)) then - call RegPackBounds(RF, 1, lbound(InData%y_SStC), ubound(InData%y_SStC)) - LB(1:1) = lbound(InData%y_SStC) - UB(1:1) = ubound(InData%y_SStC) - do i1 = LB(1), UB(1) - call StC_PackOutput(RF, InData%y_SStC(i1)) - end do - end if - call SrvD_PackModuleMapType(RF, InData%SrvD_MeshMap) - call RegPack(RF, InData%PrevTstepNcall) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SrvD_UnPackMisc(RF, OutData) +subroutine SrvD_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF - type(SrvD_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SrvD_UnPackMisc' - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) + type(SrvD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackParam' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%LastTimeCalled); if (RegCheckErr(RF, RoutineName)) return - call SrvD_UnpackBladedDLLType(RF, OutData%dll_data) ! dll_data - call RegUnpack(RF, OutData%FirstWarn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LastTimeFiltered); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%xd_BlPitchFilter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrTqF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_POSl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_POTq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_SlPc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_Slop); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_SySp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_A0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_C0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_C1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_C2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_K2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_MR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_Re1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_RLR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_RRes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_SRes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_SySp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_V1a); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_VLL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_Xe1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenEff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitchInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitchF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PitManRat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawManRat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacYawF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpdGenOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%THSSBrDp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%THSSBrFl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TimGenOf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TimGenOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TPCOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TPitManS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TYawManS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TYCOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_RtGnSp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_RtTq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_Slope); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_SlPc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_SySp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_TrGnSp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawPosCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawRateCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenModel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrMode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PCMode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VSContrl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YCMode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTiStp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTiStr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_Rgn2K); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawNeut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawDamp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TpBrDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TBDepISp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TBDrConN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TBDrConD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumNStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumSStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfCmode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfC_Mean); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfC_Amp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfC_Phase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CCmode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StCCmode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts_DLL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PriPath); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseBladedInterface); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseLegacyInterface); if (RegCheckErr(RF, RoutineName)) return + call DLLTypeUnpack(RF, OutData%DLL_Trgt) ! DLL_Trgt + call RegUnpack(RF, OutData%DLL_Ramp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlAlpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%avcOUTNAME_LEN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacYaw_North); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgWindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TrimCase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TrimGain); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeedRef); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%BStC)) deallocate(OutData%BStC) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -4322,7 +4812,7 @@ subroutine SrvD_UnPackMisc(RF, OutData) return end if do i1 = LB(1), UB(1) - call StC_UnpackMisc(RF, OutData%BStC(i1)) ! BStC + call StC_UnpackParam(RF, OutData%BStC(i1)) ! BStC end do end if if (allocated(OutData%NStC)) deallocate(OutData%NStC) @@ -4335,7 +4825,7 @@ subroutine SrvD_UnPackMisc(RF, OutData) return end if do i1 = LB(1), UB(1) - call StC_UnpackMisc(RF, OutData%NStC(i1)) ! NStC + call StC_UnpackParam(RF, OutData%NStC(i1)) ! NStC end do end if if (allocated(OutData%TStC)) deallocate(OutData%TStC) @@ -4348,7 +4838,7 @@ subroutine SrvD_UnPackMisc(RF, OutData) return end if do i1 = LB(1), UB(1) - call StC_UnpackMisc(RF, OutData%TStC(i1)) ! TStC + call StC_UnpackParam(RF, OutData%TStC(i1)) ! TStC end do end if if (allocated(OutData%SStC)) deallocate(OutData%SStC) @@ -4361,1079 +4851,603 @@ subroutine SrvD_UnPackMisc(RF, OutData) return end if do i1 = LB(1), UB(1) - call StC_UnpackMisc(RF, OutData%SStC(i1)) ! SStC - end do - end if - if (allocated(OutData%u_BStC)) deallocate(OutData%u_BStC) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_BStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_UnpackInput(RF, OutData%u_BStC(i1,i2)) ! u_BStC - end do + call StC_UnpackParam(RF, OutData%SStC(i1)) ! SStC end do end if - if (allocated(OutData%u_NStC)) deallocate(OutData%u_NStC) + call RegUnpack(RF, OutData%InterpOrder); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EXavrSWAP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumCableControl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumStC_Control); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StCMeasNumPerChan); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseSC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_x_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_nu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_BStC_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_NStC_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_TStC_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_SStC_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_BStC_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_NStC_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_TStC_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_SStC_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_BStC_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_NStC_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_TStC_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_SStC_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SensorType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBeam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumPulseGate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PulseSpacing); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%URefLid); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_NStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_UnpackInput(RF, OutData%u_NStC(i1,i2)) ! u_NStC - end do - end do + else + OutData%Vars => null() end if - if (allocated(OutData%u_TStC)) deallocate(OutData%u_TStC) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_TStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) - return +end subroutine + +subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_InputType), intent(inout) :: SrcInputData + type(SrvD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%BlPitch)) then + LB(1:1) = lbound(SrcInputData%BlPitch) + UB(1:1) = ubound(SrcInputData%BlPitch) + if (.not. allocated(DstInputData%BlPitch)) then + allocate(DstInputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BlPitch.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_UnpackInput(RF, OutData%u_TStC(i1,i2)) ! u_TStC - end do - end do + DstInputData%BlPitch = SrcInputData%BlPitch end if - if (allocated(OutData%u_SStC)) deallocate(OutData%u_SStC) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%u_SStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + DstInputData%Yaw = SrcInputData%Yaw + DstInputData%YawRate = SrcInputData%YawRate + DstInputData%LSS_Spd = SrcInputData%LSS_Spd + DstInputData%HSS_Spd = SrcInputData%HSS_Spd + DstInputData%RotSpeed = SrcInputData%RotSpeed + DstInputData%ExternalYawPosCom = SrcInputData%ExternalYawPosCom + DstInputData%ExternalYawRateCom = SrcInputData%ExternalYawRateCom + if (allocated(SrcInputData%ExternalBlPitchCom)) then + LB(1:1) = lbound(SrcInputData%ExternalBlPitchCom) + UB(1:1) = ubound(SrcInputData%ExternalBlPitchCom) + if (.not. allocated(DstInputData%ExternalBlPitchCom)) then + allocate(DstInputData%ExternalBlPitchCom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalBlPitchCom.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_UnpackInput(RF, OutData%u_SStC(i1,i2)) ! u_SStC - end do - end do + DstInputData%ExternalBlPitchCom = SrcInputData%ExternalBlPitchCom end if - if (allocated(OutData%y_BStC)) deallocate(OutData%y_BStC) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%y_BStC(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + DstInputData%ExternalGenTrq = SrcInputData%ExternalGenTrq + DstInputData%ExternalElecPwr = SrcInputData%ExternalElecPwr + DstInputData%ExternalHSSBrFrac = SrcInputData%ExternalHSSBrFrac + if (allocated(SrcInputData%ExternalBlAirfoilCom)) then + LB(1:1) = lbound(SrcInputData%ExternalBlAirfoilCom) + UB(1:1) = ubound(SrcInputData%ExternalBlAirfoilCom) + if (.not. allocated(DstInputData%ExternalBlAirfoilCom)) then + allocate(DstInputData%ExternalBlAirfoilCom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalBlAirfoilCom.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i1 = LB(1), UB(1) - call StC_UnpackOutput(RF, OutData%y_BStC(i1)) ! y_BStC - end do + DstInputData%ExternalBlAirfoilCom = SrcInputData%ExternalBlAirfoilCom end if - if (allocated(OutData%y_NStC)) deallocate(OutData%y_NStC) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%y_NStC(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + if (allocated(SrcInputData%ExternalCableDeltaL)) then + LB(1:1) = lbound(SrcInputData%ExternalCableDeltaL) + UB(1:1) = ubound(SrcInputData%ExternalCableDeltaL) + if (.not. allocated(DstInputData%ExternalCableDeltaL)) then + allocate(DstInputData%ExternalCableDeltaL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalCableDeltaL.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i1 = LB(1), UB(1) - call StC_UnpackOutput(RF, OutData%y_NStC(i1)) ! y_NStC - end do + DstInputData%ExternalCableDeltaL = SrcInputData%ExternalCableDeltaL end if - if (allocated(OutData%y_TStC)) deallocate(OutData%y_TStC) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%y_TStC(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + if (allocated(SrcInputData%ExternalCableDeltaLdot)) then + LB(1:1) = lbound(SrcInputData%ExternalCableDeltaLdot) + UB(1:1) = ubound(SrcInputData%ExternalCableDeltaLdot) + if (.not. allocated(DstInputData%ExternalCableDeltaLdot)) then + allocate(DstInputData%ExternalCableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalCableDeltaLdot.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i1 = LB(1), UB(1) - call StC_UnpackOutput(RF, OutData%y_TStC(i1)) ! y_TStC - end do + DstInputData%ExternalCableDeltaLdot = SrcInputData%ExternalCableDeltaLdot end if - if (allocated(OutData%y_SStC)) deallocate(OutData%y_SStC) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%y_SStC(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) - return + DstInputData%TwrAccel = SrcInputData%TwrAccel + DstInputData%YawErr = SrcInputData%YawErr + DstInputData%WindDir = SrcInputData%WindDir + DstInputData%RootMyc = SrcInputData%RootMyc + DstInputData%YawBrTAxp = SrcInputData%YawBrTAxp + DstInputData%YawBrTAyp = SrcInputData%YawBrTAyp + DstInputData%LSSTipPxa = SrcInputData%LSSTipPxa + DstInputData%RootMxc = SrcInputData%RootMxc + DstInputData%LSSTipMxa = SrcInputData%LSSTipMxa + DstInputData%LSSTipMya = SrcInputData%LSSTipMya + DstInputData%LSSTipMza = SrcInputData%LSSTipMza + DstInputData%LSSTipMys = SrcInputData%LSSTipMys + DstInputData%LSSTipMzs = SrcInputData%LSSTipMzs + DstInputData%YawBrMyn = SrcInputData%YawBrMyn + DstInputData%YawBrMzn = SrcInputData%YawBrMzn + DstInputData%NcIMURAxs = SrcInputData%NcIMURAxs + DstInputData%NcIMURAys = SrcInputData%NcIMURAys + DstInputData%NcIMURAzs = SrcInputData%NcIMURAzs + DstInputData%RotPwr = SrcInputData%RotPwr + DstInputData%HorWindV = SrcInputData%HorWindV + DstInputData%YawAngle = SrcInputData%YawAngle + DstInputData%LSShftFxa = SrcInputData%LSShftFxa + DstInputData%LSShftFys = SrcInputData%LSShftFys + DstInputData%LSShftFzs = SrcInputData%LSShftFzs + if (allocated(SrcInputData%fromSC)) then + LB(1:1) = lbound(SrcInputData%fromSC) + UB(1:1) = ubound(SrcInputData%fromSC) + if (.not. allocated(DstInputData%fromSC)) then + allocate(DstInputData%fromSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSC.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i1 = LB(1), UB(1) - call StC_UnpackOutput(RF, OutData%y_SStC(i1)) ! y_SStC - end do + DstInputData%fromSC = SrcInputData%fromSC end if - call SrvD_UnpackModuleMapType(RF, OutData%SrvD_MeshMap) ! SrvD_MeshMap - call RegUnpack(RF, OutData%PrevTstepNcall); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) - type(SrvD_ParameterType), intent(in) :: SrcParamData - type(SrvD_ParameterType), intent(inout) :: DstParamData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2, i3 - integer(B4Ki) :: LB(3), UB(3) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SrvD_CopyParam' - ErrStat = ErrID_None - ErrMsg = '' - DstParamData%DT = SrcParamData%DT - DstParamData%HSSBrDT = SrcParamData%HSSBrDT - DstParamData%HSSBrTqF = SrcParamData%HSSBrTqF - DstParamData%SIG_POSl = SrcParamData%SIG_POSl - DstParamData%SIG_POTq = SrcParamData%SIG_POTq - DstParamData%SIG_SlPc = SrcParamData%SIG_SlPc - DstParamData%SIG_Slop = SrcParamData%SIG_Slop - DstParamData%SIG_SySp = SrcParamData%SIG_SySp - DstParamData%TEC_A0 = SrcParamData%TEC_A0 - DstParamData%TEC_C0 = SrcParamData%TEC_C0 - DstParamData%TEC_C1 = SrcParamData%TEC_C1 - DstParamData%TEC_C2 = SrcParamData%TEC_C2 - DstParamData%TEC_K2 = SrcParamData%TEC_K2 - DstParamData%TEC_MR = SrcParamData%TEC_MR - DstParamData%TEC_Re1 = SrcParamData%TEC_Re1 - DstParamData%TEC_RLR = SrcParamData%TEC_RLR - DstParamData%TEC_RRes = SrcParamData%TEC_RRes - DstParamData%TEC_SRes = SrcParamData%TEC_SRes - DstParamData%TEC_SySp = SrcParamData%TEC_SySp - DstParamData%TEC_V1a = SrcParamData%TEC_V1a - DstParamData%TEC_VLL = SrcParamData%TEC_VLL - DstParamData%TEC_Xe1 = SrcParamData%TEC_Xe1 - DstParamData%GenEff = SrcParamData%GenEff - if (allocated(SrcParamData%BlPitchInit)) then - LB(1:1) = lbound(SrcParamData%BlPitchInit) - UB(1:1) = ubound(SrcParamData%BlPitchInit) - if (.not. allocated(DstParamData%BlPitchInit)) then - allocate(DstParamData%BlPitchInit(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInputData%fromSCglob)) then + LB(1:1) = lbound(SrcInputData%fromSCglob) + UB(1:1) = ubound(SrcInputData%fromSCglob) + if (.not. allocated(DstInputData%fromSCglob)) then + allocate(DstInputData%fromSCglob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlPitchInit.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSCglob.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%BlPitchInit = SrcParamData%BlPitchInit + DstInputData%fromSCglob = SrcInputData%fromSCglob end if - if (allocated(SrcParamData%BlPitchF)) then - LB(1:1) = lbound(SrcParamData%BlPitchF) - UB(1:1) = ubound(SrcParamData%BlPitchF) - if (.not. allocated(DstParamData%BlPitchF)) then - allocate(DstParamData%BlPitchF(LB(1):UB(1)), stat=ErrStat2) + call MeshCopy(SrcInputData%PtfmMotionMesh, DstInputData%PtfmMotionMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInputData%BStCMotionMesh)) then + LB(1:2) = lbound(SrcInputData%BStCMotionMesh) + UB(1:2) = ubound(SrcInputData%BStCMotionMesh) + if (.not. allocated(DstInputData%BStCMotionMesh)) then + allocate(DstInputData%BStCMotionMesh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlPitchF.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BStCMotionMesh.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%BlPitchF = SrcParamData%BlPitchF + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%BStCMotionMesh(i1,i2), DstInputData%BStCMotionMesh(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do end if - if (allocated(SrcParamData%PitManRat)) then - LB(1:1) = lbound(SrcParamData%PitManRat) - UB(1:1) = ubound(SrcParamData%PitManRat) - if (.not. allocated(DstParamData%PitManRat)) then - allocate(DstParamData%PitManRat(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInputData%NStCMotionMesh)) then + LB(1:1) = lbound(SrcInputData%NStCMotionMesh) + UB(1:1) = ubound(SrcInputData%NStCMotionMesh) + if (.not. allocated(DstInputData%NStCMotionMesh)) then + allocate(DstInputData%NStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PitManRat.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%NStCMotionMesh.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%PitManRat = SrcParamData%PitManRat + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%NStCMotionMesh(i1), DstInputData%NStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - DstParamData%YawManRat = SrcParamData%YawManRat - DstParamData%NacYawF = SrcParamData%NacYawF - DstParamData%SpdGenOn = SrcParamData%SpdGenOn - DstParamData%THSSBrDp = SrcParamData%THSSBrDp - DstParamData%THSSBrFl = SrcParamData%THSSBrFl - DstParamData%TimGenOf = SrcParamData%TimGenOf - DstParamData%TimGenOn = SrcParamData%TimGenOn - DstParamData%TPCOn = SrcParamData%TPCOn - if (allocated(SrcParamData%TPitManS)) then - LB(1:1) = lbound(SrcParamData%TPitManS) - UB(1:1) = ubound(SrcParamData%TPitManS) - if (.not. allocated(DstParamData%TPitManS)) then - allocate(DstParamData%TPitManS(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInputData%TStCMotionMesh)) then + LB(1:1) = lbound(SrcInputData%TStCMotionMesh) + UB(1:1) = ubound(SrcInputData%TStCMotionMesh) + if (.not. allocated(DstInputData%TStCMotionMesh)) then + allocate(DstInputData%TStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TPitManS.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%TPitManS = SrcParamData%TPitManS - end if - DstParamData%TYawManS = SrcParamData%TYawManS - DstParamData%TYCOn = SrcParamData%TYCOn - DstParamData%VS_RtGnSp = SrcParamData%VS_RtGnSp - DstParamData%VS_RtTq = SrcParamData%VS_RtTq - DstParamData%VS_Slope = SrcParamData%VS_Slope - DstParamData%VS_SlPc = SrcParamData%VS_SlPc - DstParamData%VS_SySp = SrcParamData%VS_SySp - DstParamData%VS_TrGnSp = SrcParamData%VS_TrGnSp - DstParamData%YawPosCom = SrcParamData%YawPosCom - DstParamData%YawRateCom = SrcParamData%YawRateCom - DstParamData%GenModel = SrcParamData%GenModel - DstParamData%HSSBrMode = SrcParamData%HSSBrMode - DstParamData%PCMode = SrcParamData%PCMode - DstParamData%VSContrl = SrcParamData%VSContrl - DstParamData%YCMode = SrcParamData%YCMode - DstParamData%GenTiStp = SrcParamData%GenTiStp - DstParamData%GenTiStr = SrcParamData%GenTiStr - DstParamData%VS_Rgn2K = SrcParamData%VS_Rgn2K - DstParamData%YawNeut = SrcParamData%YawNeut - DstParamData%YawSpr = SrcParamData%YawSpr - DstParamData%YawDamp = SrcParamData%YawDamp - DstParamData%TpBrDT = SrcParamData%TpBrDT - if (allocated(SrcParamData%TBDepISp)) then - LB(1:1) = lbound(SrcParamData%TBDepISp) - UB(1:1) = ubound(SrcParamData%TBDepISp) - if (.not. allocated(DstParamData%TBDepISp)) then - allocate(DstParamData%TBDepISp(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TBDepISp.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%TBDepISp = SrcParamData%TBDepISp - end if - DstParamData%TBDrConN = SrcParamData%TBDrConN - DstParamData%TBDrConD = SrcParamData%TBDrConD - DstParamData%NumBl = SrcParamData%NumBl - DstParamData%NumBStC = SrcParamData%NumBStC - DstParamData%NumNStC = SrcParamData%NumNStC - DstParamData%NumTStC = SrcParamData%NumTStC - DstParamData%NumSStC = SrcParamData%NumSStC - DstParamData%AfCmode = SrcParamData%AfCmode - DstParamData%AfC_Mean = SrcParamData%AfC_Mean - DstParamData%AfC_Amp = SrcParamData%AfC_Amp - DstParamData%AfC_Phase = SrcParamData%AfC_Phase - DstParamData%CCmode = SrcParamData%CCmode - DstParamData%StCCmode = SrcParamData%StCCmode - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%NumOuts_DLL = SrcParamData%NumOuts_DLL - DstParamData%RootName = SrcParamData%RootName - DstParamData%PriPath = SrcParamData%PriPath - if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam) - UB(1:1) = ubound(SrcParamData%OutParam) - if (.not. allocated(DstParamData%OutParam)) then - allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%TStCMotionMesh.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call MeshCopy(SrcInputData%TStCMotionMesh(i1), DstInputData%TStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - DstParamData%Delim = SrcParamData%Delim - DstParamData%UseBladedInterface = SrcParamData%UseBladedInterface - DstParamData%UseLegacyInterface = SrcParamData%UseLegacyInterface - DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt - DstParamData%DLL_Ramp = SrcParamData%DLL_Ramp - DstParamData%BlAlpha = SrcParamData%BlAlpha - DstParamData%DLL_n = SrcParamData%DLL_n - DstParamData%avcOUTNAME_LEN = SrcParamData%avcOUTNAME_LEN - DstParamData%NacYaw_North = SrcParamData%NacYaw_North - DstParamData%AvgWindSpeed = SrcParamData%AvgWindSpeed - DstParamData%AirDens = SrcParamData%AirDens - DstParamData%TrimCase = SrcParamData%TrimCase - DstParamData%TrimGain = SrcParamData%TrimGain - DstParamData%RotSpeedRef = SrcParamData%RotSpeedRef - if (allocated(SrcParamData%BStC)) then - LB(1:1) = lbound(SrcParamData%BStC) - UB(1:1) = ubound(SrcParamData%BStC) - if (.not. allocated(DstParamData%BStC)) then - allocate(DstParamData%BStC(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInputData%SStCMotionMesh)) then + LB(1:1) = lbound(SrcInputData%SStCMotionMesh) + UB(1:1) = ubound(SrcInputData%SStCMotionMesh) + if (.not. allocated(DstInputData%SStCMotionMesh)) then + allocate(DstInputData%SStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%SStCMotionMesh.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call StC_CopyParam(SrcParamData%BStC(i1), DstParamData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call MeshCopy(SrcInputData%SStCMotionMesh(i1), DstInputData%SStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcParamData%NStC)) then - LB(1:1) = lbound(SrcParamData%NStC) - UB(1:1) = ubound(SrcParamData%NStC) - if (.not. allocated(DstParamData%NStC)) then - allocate(DstParamData%NStC(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInputData%LidSpeed)) then + LB(1:1) = lbound(SrcInputData%LidSpeed) + UB(1:1) = ubound(SrcInputData%LidSpeed) + if (.not. allocated(DstInputData%LidSpeed)) then + allocate(DstInputData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%LidSpeed.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call StC_CopyParam(SrcParamData%NStC(i1), DstParamData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstInputData%LidSpeed = SrcInputData%LidSpeed end if - if (allocated(SrcParamData%TStC)) then - LB(1:1) = lbound(SrcParamData%TStC) - UB(1:1) = ubound(SrcParamData%TStC) - if (.not. allocated(DstParamData%TStC)) then - allocate(DstParamData%TStC(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInputData%MsrPositionsX)) then + LB(1:1) = lbound(SrcInputData%MsrPositionsX) + UB(1:1) = ubound(SrcInputData%MsrPositionsX) + if (.not. allocated(DstInputData%MsrPositionsX)) then + allocate(DstInputData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsX.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call StC_CopyParam(SrcParamData%TStC(i1), DstParamData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstInputData%MsrPositionsX = SrcInputData%MsrPositionsX end if - if (allocated(SrcParamData%SStC)) then - LB(1:1) = lbound(SrcParamData%SStC) - UB(1:1) = ubound(SrcParamData%SStC) - if (.not. allocated(DstParamData%SStC)) then - allocate(DstParamData%SStC(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInputData%MsrPositionsY)) then + LB(1:1) = lbound(SrcInputData%MsrPositionsY) + UB(1:1) = ubound(SrcInputData%MsrPositionsY) + if (.not. allocated(DstInputData%MsrPositionsY)) then + allocate(DstInputData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsY.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call StC_CopyParam(SrcParamData%SStC(i1), DstParamData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstInputData%MsrPositionsY = SrcInputData%MsrPositionsY end if - DstParamData%InterpOrder = SrcParamData%InterpOrder - DstParamData%EXavrSWAP = SrcParamData%EXavrSWAP - DstParamData%NumCableControl = SrcParamData%NumCableControl - DstParamData%NumStC_Control = SrcParamData%NumStC_Control - if (allocated(SrcParamData%StCMeasNumPerChan)) then - LB(1:1) = lbound(SrcParamData%StCMeasNumPerChan) - UB(1:1) = ubound(SrcParamData%StCMeasNumPerChan) - if (.not. allocated(DstParamData%StCMeasNumPerChan)) then - allocate(DstParamData%StCMeasNumPerChan(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInputData%MsrPositionsZ)) then + LB(1:1) = lbound(SrcInputData%MsrPositionsZ) + UB(1:1) = ubound(SrcInputData%MsrPositionsZ) + if (.not. allocated(DstInputData%MsrPositionsZ)) then + allocate(DstInputData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StCMeasNumPerChan.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsZ.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%StCMeasNumPerChan = SrcParamData%StCMeasNumPerChan + DstInputData%MsrPositionsZ = SrcInputData%MsrPositionsZ end if - DstParamData%UseSC = SrcParamData%UseSC - if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx) - UB(1:2) = ubound(SrcParamData%Jac_u_indx) - if (.not. allocated(DstParamData%Jac_u_indx)) then - allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx +end subroutine + +subroutine SrvD_DestroyInput(InputData, ErrStat, ErrMsg) + type(SrvD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%BlPitch)) then + deallocate(InputData%BlPitch) end if - if (allocated(SrcParamData%Jac_x_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_x_indx) - UB(1:2) = ubound(SrcParamData%Jac_x_indx) - if (.not. allocated(DstParamData%Jac_x_indx)) then - allocate(DstParamData%Jac_x_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_x_indx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_x_indx = SrcParamData%Jac_x_indx + if (allocated(InputData%ExternalBlPitchCom)) then + deallocate(InputData%ExternalBlPitchCom) end if - if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du) - UB(1:1) = ubound(SrcParamData%du) - if (.not. allocated(DstParamData%du)) then - allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%du = SrcParamData%du + if (allocated(InputData%ExternalBlAirfoilCom)) then + deallocate(InputData%ExternalBlAirfoilCom) end if - if (allocated(SrcParamData%dx)) then - LB(1:1) = lbound(SrcParamData%dx) - UB(1:1) = ubound(SrcParamData%dx) - if (.not. allocated(DstParamData%dx)) then - allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%dx = SrcParamData%dx + if (allocated(InputData%ExternalCableDeltaL)) then + deallocate(InputData%ExternalCableDeltaL) end if - DstParamData%Jac_nu = SrcParamData%Jac_nu - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%Jac_nx = SrcParamData%Jac_nx - if (allocated(SrcParamData%Jac_Idx_BStC_u)) then - LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_u) - UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_u) - if (.not. allocated(DstParamData%Jac_Idx_BStC_u)) then - allocate(DstParamData%Jac_Idx_BStC_u(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_BStC_u = SrcParamData%Jac_Idx_BStC_u + if (allocated(InputData%ExternalCableDeltaLdot)) then + deallocate(InputData%ExternalCableDeltaLdot) end if - if (allocated(SrcParamData%Jac_Idx_NStC_u)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_u) - UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_u) - if (.not. allocated(DstParamData%Jac_Idx_NStC_u)) then - allocate(DstParamData%Jac_Idx_NStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_NStC_u = SrcParamData%Jac_Idx_NStC_u + if (allocated(InputData%fromSC)) then + deallocate(InputData%fromSC) end if - if (allocated(SrcParamData%Jac_Idx_TStC_u)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_u) - UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_u) - if (.not. allocated(DstParamData%Jac_Idx_TStC_u)) then - allocate(DstParamData%Jac_Idx_TStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_TStC_u = SrcParamData%Jac_Idx_TStC_u - end if - if (allocated(SrcParamData%Jac_Idx_SStC_u)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_u) - UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_u) - if (.not. allocated(DstParamData%Jac_Idx_SStC_u)) then - allocate(DstParamData%Jac_Idx_SStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_SStC_u = SrcParamData%Jac_Idx_SStC_u - end if - if (allocated(SrcParamData%Jac_Idx_BStC_x)) then - LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_x) - UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_x) - if (.not. allocated(DstParamData%Jac_Idx_BStC_x)) then - allocate(DstParamData%Jac_Idx_BStC_x(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_x.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_BStC_x = SrcParamData%Jac_Idx_BStC_x - end if - if (allocated(SrcParamData%Jac_Idx_NStC_x)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_x) - UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_x) - if (.not. allocated(DstParamData%Jac_Idx_NStC_x)) then - allocate(DstParamData%Jac_Idx_NStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_x.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_NStC_x = SrcParamData%Jac_Idx_NStC_x - end if - if (allocated(SrcParamData%Jac_Idx_TStC_x)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_x) - UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_x) - if (.not. allocated(DstParamData%Jac_Idx_TStC_x)) then - allocate(DstParamData%Jac_Idx_TStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_x.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_TStC_x = SrcParamData%Jac_Idx_TStC_x - end if - if (allocated(SrcParamData%Jac_Idx_SStC_x)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_x) - UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_x) - if (.not. allocated(DstParamData%Jac_Idx_SStC_x)) then - allocate(DstParamData%Jac_Idx_SStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_x.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_SStC_x = SrcParamData%Jac_Idx_SStC_x - end if - if (allocated(SrcParamData%Jac_Idx_BStC_y)) then - LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_y) - UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_y) - if (.not. allocated(DstParamData%Jac_Idx_BStC_y)) then - allocate(DstParamData%Jac_Idx_BStC_y(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_BStC_y = SrcParamData%Jac_Idx_BStC_y - end if - if (allocated(SrcParamData%Jac_Idx_NStC_y)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_y) - UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_y) - if (.not. allocated(DstParamData%Jac_Idx_NStC_y)) then - allocate(DstParamData%Jac_Idx_NStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_NStC_y = SrcParamData%Jac_Idx_NStC_y - end if - if (allocated(SrcParamData%Jac_Idx_TStC_y)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_y) - UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_y) - if (.not. allocated(DstParamData%Jac_Idx_TStC_y)) then - allocate(DstParamData%Jac_Idx_TStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_TStC_y = SrcParamData%Jac_Idx_TStC_y - end if - if (allocated(SrcParamData%Jac_Idx_SStC_y)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_y) - UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_y) - if (.not. allocated(DstParamData%Jac_Idx_SStC_y)) then - allocate(DstParamData%Jac_Idx_SStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_Idx_SStC_y = SrcParamData%Jac_Idx_SStC_y - end if - DstParamData%SensorType = SrcParamData%SensorType - DstParamData%NumBeam = SrcParamData%NumBeam - DstParamData%NumPulseGate = SrcParamData%NumPulseGate - DstParamData%PulseSpacing = SrcParamData%PulseSpacing - DstParamData%URefLid = SrcParamData%URefLid -end subroutine - -subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) - type(SrvD_ParameterType), intent(inout) :: ParamData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2, i3 - integer(B4Ki) :: LB(3), UB(3) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SrvD_DestroyParam' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(ParamData%BlPitchInit)) then - deallocate(ParamData%BlPitchInit) - end if - if (allocated(ParamData%BlPitchF)) then - deallocate(ParamData%BlPitchF) - end if - if (allocated(ParamData%PitManRat)) then - deallocate(ParamData%PitManRat) - end if - if (allocated(ParamData%TPitManS)) then - deallocate(ParamData%TPitManS) - end if - if (allocated(ParamData%TBDepISp)) then - deallocate(ParamData%TBDepISp) - end if - if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam) - UB(1:1) = ubound(ParamData%OutParam) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ParamData%OutParam) + if (allocated(InputData%fromSCglob)) then + deallocate(InputData%fromSCglob) end if - call FreeDynamicLib( ParamData%DLL_Trgt, ErrStat2, ErrMsg2) + call MeshDestroy( InputData%PtfmMotionMesh, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(ParamData%BStC)) then - LB(1:1) = lbound(ParamData%BStC) - UB(1:1) = ubound(ParamData%BStC) - do i1 = LB(1), UB(1) - call StC_DestroyParam(ParamData%BStC(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InputData%BStCMotionMesh)) then + LB(1:2) = lbound(InputData%BStCMotionMesh) + UB(1:2) = ubound(InputData%BStCMotionMesh) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%BStCMotionMesh(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do end do - deallocate(ParamData%BStC) + deallocate(InputData%BStCMotionMesh) end if - if (allocated(ParamData%NStC)) then - LB(1:1) = lbound(ParamData%NStC) - UB(1:1) = ubound(ParamData%NStC) + if (allocated(InputData%NStCMotionMesh)) then + LB(1:1) = lbound(InputData%NStCMotionMesh) + UB(1:1) = ubound(InputData%NStCMotionMesh) do i1 = LB(1), UB(1) - call StC_DestroyParam(ParamData%NStC(i1), ErrStat2, ErrMsg2) + call MeshDestroy( InputData%NStCMotionMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(ParamData%NStC) + deallocate(InputData%NStCMotionMesh) end if - if (allocated(ParamData%TStC)) then - LB(1:1) = lbound(ParamData%TStC) - UB(1:1) = ubound(ParamData%TStC) + if (allocated(InputData%TStCMotionMesh)) then + LB(1:1) = lbound(InputData%TStCMotionMesh) + UB(1:1) = ubound(InputData%TStCMotionMesh) do i1 = LB(1), UB(1) - call StC_DestroyParam(ParamData%TStC(i1), ErrStat2, ErrMsg2) + call MeshDestroy( InputData%TStCMotionMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(ParamData%TStC) + deallocate(InputData%TStCMotionMesh) end if - if (allocated(ParamData%SStC)) then - LB(1:1) = lbound(ParamData%SStC) - UB(1:1) = ubound(ParamData%SStC) + if (allocated(InputData%SStCMotionMesh)) then + LB(1:1) = lbound(InputData%SStCMotionMesh) + UB(1:1) = ubound(InputData%SStCMotionMesh) do i1 = LB(1), UB(1) - call StC_DestroyParam(ParamData%SStC(i1), ErrStat2, ErrMsg2) + call MeshDestroy( InputData%SStCMotionMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(ParamData%SStC) - end if - if (allocated(ParamData%StCMeasNumPerChan)) then - deallocate(ParamData%StCMeasNumPerChan) - end if - if (allocated(ParamData%Jac_u_indx)) then - deallocate(ParamData%Jac_u_indx) - end if - if (allocated(ParamData%Jac_x_indx)) then - deallocate(ParamData%Jac_x_indx) - end if - if (allocated(ParamData%du)) then - deallocate(ParamData%du) - end if - if (allocated(ParamData%dx)) then - deallocate(ParamData%dx) - end if - if (allocated(ParamData%Jac_Idx_BStC_u)) then - deallocate(ParamData%Jac_Idx_BStC_u) - end if - if (allocated(ParamData%Jac_Idx_NStC_u)) then - deallocate(ParamData%Jac_Idx_NStC_u) - end if - if (allocated(ParamData%Jac_Idx_TStC_u)) then - deallocate(ParamData%Jac_Idx_TStC_u) - end if - if (allocated(ParamData%Jac_Idx_SStC_u)) then - deallocate(ParamData%Jac_Idx_SStC_u) + deallocate(InputData%SStCMotionMesh) end if - if (allocated(ParamData%Jac_Idx_BStC_x)) then - deallocate(ParamData%Jac_Idx_BStC_x) + if (allocated(InputData%LidSpeed)) then + deallocate(InputData%LidSpeed) end if - if (allocated(ParamData%Jac_Idx_NStC_x)) then - deallocate(ParamData%Jac_Idx_NStC_x) + if (allocated(InputData%MsrPositionsX)) then + deallocate(InputData%MsrPositionsX) end if - if (allocated(ParamData%Jac_Idx_TStC_x)) then - deallocate(ParamData%Jac_Idx_TStC_x) + if (allocated(InputData%MsrPositionsY)) then + deallocate(InputData%MsrPositionsY) end if - if (allocated(ParamData%Jac_Idx_SStC_x)) then - deallocate(ParamData%Jac_Idx_SStC_x) - end if - if (allocated(ParamData%Jac_Idx_BStC_y)) then - deallocate(ParamData%Jac_Idx_BStC_y) - end if - if (allocated(ParamData%Jac_Idx_NStC_y)) then - deallocate(ParamData%Jac_Idx_NStC_y) - end if - if (allocated(ParamData%Jac_Idx_TStC_y)) then - deallocate(ParamData%Jac_Idx_TStC_y) - end if - if (allocated(ParamData%Jac_Idx_SStC_y)) then - deallocate(ParamData%Jac_Idx_SStC_y) + if (allocated(InputData%MsrPositionsZ)) then + deallocate(InputData%MsrPositionsZ) end if end subroutine -subroutine SrvD_PackParam(RF, Indata) +subroutine SrvD_PackInput(RF, Indata) type(RegFile), intent(inout) :: RF - type(SrvD_ParameterType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SrvD_PackParam' - integer(B4Ki) :: i1, i2, i3 - integer(B4Ki) :: LB(3), UB(3) + type(SrvD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackInput' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%DT) - call RegPack(RF, InData%HSSBrDT) - call RegPack(RF, InData%HSSBrTqF) - call RegPack(RF, InData%SIG_POSl) - call RegPack(RF, InData%SIG_POTq) - call RegPack(RF, InData%SIG_SlPc) - call RegPack(RF, InData%SIG_Slop) - call RegPack(RF, InData%SIG_SySp) - call RegPack(RF, InData%TEC_A0) - call RegPack(RF, InData%TEC_C0) - call RegPack(RF, InData%TEC_C1) - call RegPack(RF, InData%TEC_C2) - call RegPack(RF, InData%TEC_K2) - call RegPack(RF, InData%TEC_MR) - call RegPack(RF, InData%TEC_Re1) - call RegPack(RF, InData%TEC_RLR) - call RegPack(RF, InData%TEC_RRes) - call RegPack(RF, InData%TEC_SRes) - call RegPack(RF, InData%TEC_SySp) - call RegPack(RF, InData%TEC_V1a) - call RegPack(RF, InData%TEC_VLL) - call RegPack(RF, InData%TEC_Xe1) - call RegPack(RF, InData%GenEff) - call RegPackAlloc(RF, InData%BlPitchInit) - call RegPackAlloc(RF, InData%BlPitchF) - call RegPackAlloc(RF, InData%PitManRat) - call RegPack(RF, InData%YawManRat) - call RegPack(RF, InData%NacYawF) - call RegPack(RF, InData%SpdGenOn) - call RegPack(RF, InData%THSSBrDp) - call RegPack(RF, InData%THSSBrFl) - call RegPack(RF, InData%TimGenOf) - call RegPack(RF, InData%TimGenOn) - call RegPack(RF, InData%TPCOn) - call RegPackAlloc(RF, InData%TPitManS) - call RegPack(RF, InData%TYawManS) - call RegPack(RF, InData%TYCOn) - call RegPack(RF, InData%VS_RtGnSp) - call RegPack(RF, InData%VS_RtTq) - call RegPack(RF, InData%VS_Slope) - call RegPack(RF, InData%VS_SlPc) - call RegPack(RF, InData%VS_SySp) - call RegPack(RF, InData%VS_TrGnSp) - call RegPack(RF, InData%YawPosCom) - call RegPack(RF, InData%YawRateCom) - call RegPack(RF, InData%GenModel) - call RegPack(RF, InData%HSSBrMode) - call RegPack(RF, InData%PCMode) - call RegPack(RF, InData%VSContrl) - call RegPack(RF, InData%YCMode) - call RegPack(RF, InData%GenTiStp) - call RegPack(RF, InData%GenTiStr) - call RegPack(RF, InData%VS_Rgn2K) - call RegPack(RF, InData%YawNeut) - call RegPack(RF, InData%YawSpr) - call RegPack(RF, InData%YawDamp) - call RegPack(RF, InData%TpBrDT) - call RegPackAlloc(RF, InData%TBDepISp) - call RegPack(RF, InData%TBDrConN) - call RegPack(RF, InData%TBDrConD) - call RegPack(RF, InData%NumBl) - call RegPack(RF, InData%NumBStC) - call RegPack(RF, InData%NumNStC) - call RegPack(RF, InData%NumTStC) - call RegPack(RF, InData%NumSStC) - call RegPack(RF, InData%AfCmode) - call RegPack(RF, InData%AfC_Mean) - call RegPack(RF, InData%AfC_Amp) - call RegPack(RF, InData%AfC_Phase) - call RegPack(RF, InData%CCmode) - call RegPack(RF, InData%StCCmode) - call RegPack(RF, InData%NumOuts) - call RegPack(RF, InData%NumOuts_DLL) - call RegPack(RF, InData%RootName) - call RegPack(RF, InData%PriPath) - call RegPack(RF, allocated(InData%OutParam)) - if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) - LB(1:1) = lbound(InData%OutParam) - UB(1:1) = ubound(InData%OutParam) - do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) - end do - end if - call RegPack(RF, InData%Delim) - call RegPack(RF, InData%UseBladedInterface) - call RegPack(RF, InData%UseLegacyInterface) - call DLLTypePack(RF, InData%DLL_Trgt) - call RegPack(RF, InData%DLL_Ramp) - call RegPack(RF, InData%BlAlpha) - call RegPack(RF, InData%DLL_n) - call RegPack(RF, InData%avcOUTNAME_LEN) - call RegPack(RF, InData%NacYaw_North) - call RegPack(RF, InData%AvgWindSpeed) - call RegPack(RF, InData%AirDens) - call RegPack(RF, InData%TrimCase) - call RegPack(RF, InData%TrimGain) - call RegPack(RF, InData%RotSpeedRef) - call RegPack(RF, allocated(InData%BStC)) - if (allocated(InData%BStC)) then - call RegPackBounds(RF, 1, lbound(InData%BStC), ubound(InData%BStC)) - LB(1:1) = lbound(InData%BStC) - UB(1:1) = ubound(InData%BStC) - do i1 = LB(1), UB(1) - call StC_PackParam(RF, InData%BStC(i1)) + call RegPackAlloc(RF, InData%BlPitch) + call RegPack(RF, InData%Yaw) + call RegPack(RF, InData%YawRate) + call RegPack(RF, InData%LSS_Spd) + call RegPack(RF, InData%HSS_Spd) + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%ExternalYawPosCom) + call RegPack(RF, InData%ExternalYawRateCom) + call RegPackAlloc(RF, InData%ExternalBlPitchCom) + call RegPack(RF, InData%ExternalGenTrq) + call RegPack(RF, InData%ExternalElecPwr) + call RegPack(RF, InData%ExternalHSSBrFrac) + call RegPackAlloc(RF, InData%ExternalBlAirfoilCom) + call RegPackAlloc(RF, InData%ExternalCableDeltaL) + call RegPackAlloc(RF, InData%ExternalCableDeltaLdot) + call RegPack(RF, InData%TwrAccel) + call RegPack(RF, InData%YawErr) + call RegPack(RF, InData%WindDir) + call RegPack(RF, InData%RootMyc) + call RegPack(RF, InData%YawBrTAxp) + call RegPack(RF, InData%YawBrTAyp) + call RegPack(RF, InData%LSSTipPxa) + call RegPack(RF, InData%RootMxc) + call RegPack(RF, InData%LSSTipMxa) + call RegPack(RF, InData%LSSTipMya) + call RegPack(RF, InData%LSSTipMza) + call RegPack(RF, InData%LSSTipMys) + call RegPack(RF, InData%LSSTipMzs) + call RegPack(RF, InData%YawBrMyn) + call RegPack(RF, InData%YawBrMzn) + call RegPack(RF, InData%NcIMURAxs) + call RegPack(RF, InData%NcIMURAys) + call RegPack(RF, InData%NcIMURAzs) + call RegPack(RF, InData%RotPwr) + call RegPack(RF, InData%HorWindV) + call RegPack(RF, InData%YawAngle) + call RegPack(RF, InData%LSShftFxa) + call RegPack(RF, InData%LSShftFys) + call RegPack(RF, InData%LSShftFzs) + call RegPackAlloc(RF, InData%fromSC) + call RegPackAlloc(RF, InData%fromSCglob) + call MeshPack(RF, InData%PtfmMotionMesh) + call RegPack(RF, allocated(InData%BStCMotionMesh)) + if (allocated(InData%BStCMotionMesh)) then + call RegPackBounds(RF, 2, lbound(InData%BStCMotionMesh), ubound(InData%BStCMotionMesh)) + LB(1:2) = lbound(InData%BStCMotionMesh) + UB(1:2) = ubound(InData%BStCMotionMesh) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BStCMotionMesh(i1,i2)) + end do end do end if - call RegPack(RF, allocated(InData%NStC)) - if (allocated(InData%NStC)) then - call RegPackBounds(RF, 1, lbound(InData%NStC), ubound(InData%NStC)) - LB(1:1) = lbound(InData%NStC) - UB(1:1) = ubound(InData%NStC) + call RegPack(RF, allocated(InData%NStCMotionMesh)) + if (allocated(InData%NStCMotionMesh)) then + call RegPackBounds(RF, 1, lbound(InData%NStCMotionMesh), ubound(InData%NStCMotionMesh)) + LB(1:1) = lbound(InData%NStCMotionMesh) + UB(1:1) = ubound(InData%NStCMotionMesh) do i1 = LB(1), UB(1) - call StC_PackParam(RF, InData%NStC(i1)) + call MeshPack(RF, InData%NStCMotionMesh(i1)) end do end if - call RegPack(RF, allocated(InData%TStC)) - if (allocated(InData%TStC)) then - call RegPackBounds(RF, 1, lbound(InData%TStC), ubound(InData%TStC)) - LB(1:1) = lbound(InData%TStC) - UB(1:1) = ubound(InData%TStC) + call RegPack(RF, allocated(InData%TStCMotionMesh)) + if (allocated(InData%TStCMotionMesh)) then + call RegPackBounds(RF, 1, lbound(InData%TStCMotionMesh), ubound(InData%TStCMotionMesh)) + LB(1:1) = lbound(InData%TStCMotionMesh) + UB(1:1) = ubound(InData%TStCMotionMesh) do i1 = LB(1), UB(1) - call StC_PackParam(RF, InData%TStC(i1)) + call MeshPack(RF, InData%TStCMotionMesh(i1)) end do end if - call RegPack(RF, allocated(InData%SStC)) - if (allocated(InData%SStC)) then - call RegPackBounds(RF, 1, lbound(InData%SStC), ubound(InData%SStC)) - LB(1:1) = lbound(InData%SStC) - UB(1:1) = ubound(InData%SStC) + call RegPack(RF, allocated(InData%SStCMotionMesh)) + if (allocated(InData%SStCMotionMesh)) then + call RegPackBounds(RF, 1, lbound(InData%SStCMotionMesh), ubound(InData%SStCMotionMesh)) + LB(1:1) = lbound(InData%SStCMotionMesh) + UB(1:1) = ubound(InData%SStCMotionMesh) do i1 = LB(1), UB(1) - call StC_PackParam(RF, InData%SStC(i1)) + call MeshPack(RF, InData%SStCMotionMesh(i1)) end do end if - call RegPack(RF, InData%InterpOrder) - call RegPack(RF, InData%EXavrSWAP) - call RegPack(RF, InData%NumCableControl) - call RegPack(RF, InData%NumStC_Control) - call RegPackAlloc(RF, InData%StCMeasNumPerChan) - call RegPack(RF, InData%UseSC) - call RegPackAlloc(RF, InData%Jac_u_indx) - call RegPackAlloc(RF, InData%Jac_x_indx) - call RegPackAlloc(RF, InData%du) - call RegPackAlloc(RF, InData%dx) - call RegPack(RF, InData%Jac_nu) - call RegPack(RF, InData%Jac_ny) - call RegPack(RF, InData%Jac_nx) - call RegPackAlloc(RF, InData%Jac_Idx_BStC_u) - call RegPackAlloc(RF, InData%Jac_Idx_NStC_u) - call RegPackAlloc(RF, InData%Jac_Idx_TStC_u) - call RegPackAlloc(RF, InData%Jac_Idx_SStC_u) - call RegPackAlloc(RF, InData%Jac_Idx_BStC_x) - call RegPackAlloc(RF, InData%Jac_Idx_NStC_x) - call RegPackAlloc(RF, InData%Jac_Idx_TStC_x) - call RegPackAlloc(RF, InData%Jac_Idx_SStC_x) - call RegPackAlloc(RF, InData%Jac_Idx_BStC_y) - call RegPackAlloc(RF, InData%Jac_Idx_NStC_y) - call RegPackAlloc(RF, InData%Jac_Idx_TStC_y) - call RegPackAlloc(RF, InData%Jac_Idx_SStC_y) - call RegPack(RF, InData%SensorType) - call RegPack(RF, InData%NumBeam) - call RegPack(RF, InData%NumPulseGate) - call RegPack(RF, InData%PulseSpacing) - call RegPack(RF, InData%URefLid) + call RegPackAlloc(RF, InData%LidSpeed) + call RegPackAlloc(RF, InData%MsrPositionsX) + call RegPackAlloc(RF, InData%MsrPositionsY) + call RegPackAlloc(RF, InData%MsrPositionsZ) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SrvD_UnPackParam(RF, OutData) +subroutine SrvD_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF - type(SrvD_ParameterType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SrvD_UnPackParam' - integer(B4Ki) :: i1, i2, i3 - integer(B4Ki) :: LB(3), UB(3) + type(SrvD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackInput' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%HSSBrDT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%HSSBrTqF); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SIG_POSl); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SIG_POTq); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SIG_SlPc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SIG_Slop); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SIG_SySp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_A0); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_C0); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_C1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_C2); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_K2); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_MR); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_Re1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_RLR); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_RRes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_SRes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_SySp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_V1a); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_VLL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TEC_Xe1); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%GenEff); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlPitchInit); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlPitchF); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%PitManRat); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawManRat); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NacYawF); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SpdGenOn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%THSSBrDp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%THSSBrFl); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TimGenOf); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TimGenOn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TPCOn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TPitManS); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TYawManS); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TYCOn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VS_RtGnSp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VS_RtTq); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VS_Slope); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VS_SlPc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VS_SySp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VS_TrGnSp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawPosCom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawRateCom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%GenModel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%HSSBrMode); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%PCMode); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VSContrl); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YCMode); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%GenTiStp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%GenTiStr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%VS_Rgn2K); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawNeut); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawSpr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawDamp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TpBrDT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TBDepISp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TBDrConN); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TBDrConD); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumBStC); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumNStC); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumTStC); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumSStC); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AfCmode); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AfC_Mean); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AfC_Amp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AfC_Phase); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%CCmode); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%StCCmode); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumOuts_DLL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%PriPath); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam - end do - end if - call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%UseBladedInterface); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%UseLegacyInterface); if (RegCheckErr(RF, RoutineName)) return - call DLLTypeUnpack(RF, OutData%DLL_Trgt) ! DLL_Trgt - call RegUnpack(RF, OutData%DLL_Ramp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%BlAlpha); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%DLL_n); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%avcOUTNAME_LEN); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NacYaw_North); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AvgWindSpeed); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TrimCase); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TrimGain); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RotSpeedRef); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%BStC)) deallocate(OutData%BStC) + call RegUnpackAlloc(RF, OutData%BlPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Yaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawRate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSS_Spd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSS_Spd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExternalYawPosCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExternalYawRateCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ExternalBlPitchCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExternalGenTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExternalElecPwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExternalHSSBrFrac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ExternalBlAirfoilCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ExternalCableDeltaL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ExternalCableDeltaLdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrAccel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawErr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootMyc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrTAxp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrTAyp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipPxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootMxc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMya); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMza); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrMyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrMzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAxs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotPwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HorWindV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawAngle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fromSC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fromSCglob); if (RegCheckErr(RF, RoutineName)) return + call MeshUnpack(RF, OutData%PtfmMotionMesh) ! PtfmMotionMesh + if (allocated(OutData%BStCMotionMesh)) deallocate(OutData%BStCMotionMesh) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BStC(LB(1):UB(1)),stat=stat) + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BStCMotionMesh(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - do i1 = LB(1), UB(1) - call StC_UnpackParam(RF, OutData%BStC(i1)) ! BStC + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BStCMotionMesh(i1,i2)) ! BStCMotionMesh + end do end do end if - if (allocated(OutData%NStC)) deallocate(OutData%NStC) + if (allocated(OutData%NStCMotionMesh)) deallocate(OutData%NStCMotionMesh) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%NStC(LB(1):UB(1)),stat=stat) + allocate(OutData%NStCMotionMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackParam(RF, OutData%NStC(i1)) ! NStC + call MeshUnpack(RF, OutData%NStCMotionMesh(i1)) ! NStCMotionMesh end do end if - if (allocated(OutData%TStC)) deallocate(OutData%TStC) + if (allocated(OutData%TStCMotionMesh)) deallocate(OutData%TStCMotionMesh) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%TStC(LB(1):UB(1)),stat=stat) + allocate(OutData%TStCMotionMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackParam(RF, OutData%TStC(i1)) ! TStC + call MeshUnpack(RF, OutData%TStCMotionMesh(i1)) ! TStCMotionMesh end do end if - if (allocated(OutData%SStC)) deallocate(OutData%SStC) + if (allocated(OutData%SStCMotionMesh)) deallocate(OutData%SStCMotionMesh) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%SStC(LB(1):UB(1)),stat=stat) + allocate(OutData%SStCMotionMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackParam(RF, OutData%SStC(i1)) ! SStC + call MeshUnpack(RF, OutData%SStCMotionMesh(i1)) ! SStCMotionMesh end do end if - call RegUnpack(RF, OutData%InterpOrder); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%EXavrSWAP); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumCableControl); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumStC_Control); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%StCMeasNumPerChan); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%UseSC); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_x_indx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_nu); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_nx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_BStC_u); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_NStC_u); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_TStC_u); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_SStC_u); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_BStC_x); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_NStC_x); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_TStC_x); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_SStC_x); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_BStC_y); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_NStC_y); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_TStC_y); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_Idx_SStC_y); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%SensorType); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumBeam); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumPulseGate); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%PulseSpacing); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%URefLid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LidSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsZ); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) - type(SrvD_InputType), intent(inout) :: SrcInputData - type(SrvD_InputType), intent(inout) :: DstInputData +subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_OutputType), intent(inout) :: SrcOutputData + type(SrvD_OutputType), intent(inout) :: DstOutputData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg @@ -5441,917 +5455,1099 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SrvD_CopyInput' + character(*), parameter :: RoutineName = 'SrvD_CopyOutput' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcInputData%BlPitch)) then - LB(1:1) = lbound(SrcInputData%BlPitch) - UB(1:1) = ubound(SrcInputData%BlPitch) - if (.not. allocated(DstInputData%BlPitch)) then - allocate(DstInputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BlPitch.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInputData%BlPitch = SrcInputData%BlPitch - end if - DstInputData%Yaw = SrcInputData%Yaw - DstInputData%YawRate = SrcInputData%YawRate - DstInputData%LSS_Spd = SrcInputData%LSS_Spd - DstInputData%HSS_Spd = SrcInputData%HSS_Spd - DstInputData%RotSpeed = SrcInputData%RotSpeed - DstInputData%ExternalYawPosCom = SrcInputData%ExternalYawPosCom - DstInputData%ExternalYawRateCom = SrcInputData%ExternalYawRateCom - if (allocated(SrcInputData%ExternalBlPitchCom)) then - LB(1:1) = lbound(SrcInputData%ExternalBlPitchCom) - UB(1:1) = ubound(SrcInputData%ExternalBlPitchCom) - if (.not. allocated(DstInputData%ExternalBlPitchCom)) then - allocate(DstInputData%ExternalBlPitchCom(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalBlPitchCom.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputData%ExternalBlPitchCom = SrcInputData%ExternalBlPitchCom + DstOutputData%WriteOutput = SrcOutputData%WriteOutput end if - DstInputData%ExternalGenTrq = SrcInputData%ExternalGenTrq - DstInputData%ExternalElecPwr = SrcInputData%ExternalElecPwr - DstInputData%ExternalHSSBrFrac = SrcInputData%ExternalHSSBrFrac - if (allocated(SrcInputData%ExternalBlAirfoilCom)) then - LB(1:1) = lbound(SrcInputData%ExternalBlAirfoilCom) - UB(1:1) = ubound(SrcInputData%ExternalBlAirfoilCom) - if (.not. allocated(DstInputData%ExternalBlAirfoilCom)) then - allocate(DstInputData%ExternalBlAirfoilCom(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%BlPitchCom)) then + LB(1:1) = lbound(SrcOutputData%BlPitchCom) + UB(1:1) = ubound(SrcOutputData%BlPitchCom) + if (.not. allocated(DstOutputData%BlPitchCom)) then + allocate(DstOutputData%BlPitchCom(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalBlAirfoilCom.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlPitchCom.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputData%ExternalBlAirfoilCom = SrcInputData%ExternalBlAirfoilCom + DstOutputData%BlPitchCom = SrcOutputData%BlPitchCom end if - if (allocated(SrcInputData%ExternalCableDeltaL)) then - LB(1:1) = lbound(SrcInputData%ExternalCableDeltaL) - UB(1:1) = ubound(SrcInputData%ExternalCableDeltaL) - if (.not. allocated(DstInputData%ExternalCableDeltaL)) then - allocate(DstInputData%ExternalCableDeltaL(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%BlAirfoilCom)) then + LB(1:1) = lbound(SrcOutputData%BlAirfoilCom) + UB(1:1) = ubound(SrcOutputData%BlAirfoilCom) + if (.not. allocated(DstOutputData%BlAirfoilCom)) then + allocate(DstOutputData%BlAirfoilCom(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalCableDeltaL.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlAirfoilCom.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputData%ExternalCableDeltaL = SrcInputData%ExternalCableDeltaL + DstOutputData%BlAirfoilCom = SrcOutputData%BlAirfoilCom end if - if (allocated(SrcInputData%ExternalCableDeltaLdot)) then - LB(1:1) = lbound(SrcInputData%ExternalCableDeltaLdot) - UB(1:1) = ubound(SrcInputData%ExternalCableDeltaLdot) - if (.not. allocated(DstInputData%ExternalCableDeltaLdot)) then - allocate(DstInputData%ExternalCableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) + DstOutputData%YawMom = SrcOutputData%YawMom + DstOutputData%YawPosCom = SrcOutputData%YawPosCom + DstOutputData%YawRateCom = SrcOutputData%YawRateCom + DstOutputData%GenTrq = SrcOutputData%GenTrq + DstOutputData%HSSBrTrqC = SrcOutputData%HSSBrTrqC + DstOutputData%ElecPwr = SrcOutputData%ElecPwr + if (allocated(SrcOutputData%TBDrCon)) then + LB(1:1) = lbound(SrcOutputData%TBDrCon) + UB(1:1) = ubound(SrcOutputData%TBDrCon) + if (.not. allocated(DstOutputData%TBDrCon)) then + allocate(DstOutputData%TBDrCon(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalCableDeltaLdot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TBDrCon.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputData%ExternalCableDeltaLdot = SrcInputData%ExternalCableDeltaLdot + DstOutputData%TBDrCon = SrcOutputData%TBDrCon end if - DstInputData%TwrAccel = SrcInputData%TwrAccel - DstInputData%YawErr = SrcInputData%YawErr - DstInputData%WindDir = SrcInputData%WindDir - DstInputData%RootMyc = SrcInputData%RootMyc - DstInputData%YawBrTAxp = SrcInputData%YawBrTAxp - DstInputData%YawBrTAyp = SrcInputData%YawBrTAyp - DstInputData%LSSTipPxa = SrcInputData%LSSTipPxa - DstInputData%RootMxc = SrcInputData%RootMxc - DstInputData%LSSTipMxa = SrcInputData%LSSTipMxa - DstInputData%LSSTipMya = SrcInputData%LSSTipMya - DstInputData%LSSTipMza = SrcInputData%LSSTipMza - DstInputData%LSSTipMys = SrcInputData%LSSTipMys - DstInputData%LSSTipMzs = SrcInputData%LSSTipMzs - DstInputData%YawBrMyn = SrcInputData%YawBrMyn - DstInputData%YawBrMzn = SrcInputData%YawBrMzn - DstInputData%NcIMURAxs = SrcInputData%NcIMURAxs - DstInputData%NcIMURAys = SrcInputData%NcIMURAys - DstInputData%NcIMURAzs = SrcInputData%NcIMURAzs - DstInputData%RotPwr = SrcInputData%RotPwr - DstInputData%HorWindV = SrcInputData%HorWindV - DstInputData%YawAngle = SrcInputData%YawAngle - DstInputData%LSShftFxa = SrcInputData%LSShftFxa - DstInputData%LSShftFys = SrcInputData%LSShftFys - DstInputData%LSShftFzs = SrcInputData%LSShftFzs - if (allocated(SrcInputData%fromSC)) then - LB(1:1) = lbound(SrcInputData%fromSC) - UB(1:1) = ubound(SrcInputData%fromSC) - if (.not. allocated(DstInputData%fromSC)) then - allocate(DstInputData%fromSC(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%CableDeltaL)) then + LB(1:1) = lbound(SrcOutputData%CableDeltaL) + UB(1:1) = ubound(SrcOutputData%CableDeltaL) + if (.not. allocated(DstOutputData%CableDeltaL)) then + allocate(DstOutputData%CableDeltaL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CableDeltaL.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputData%fromSC = SrcInputData%fromSC + DstOutputData%CableDeltaL = SrcOutputData%CableDeltaL end if - if (allocated(SrcInputData%fromSCglob)) then - LB(1:1) = lbound(SrcInputData%fromSCglob) - UB(1:1) = ubound(SrcInputData%fromSCglob) - if (.not. allocated(DstInputData%fromSCglob)) then - allocate(DstInputData%fromSCglob(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%CableDeltaLdot)) then + LB(1:1) = lbound(SrcOutputData%CableDeltaLdot) + UB(1:1) = ubound(SrcOutputData%CableDeltaLdot) + if (.not. allocated(DstOutputData%CableDeltaLdot)) then + allocate(DstOutputData%CableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSCglob.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CableDeltaLdot.', ErrStat, ErrMsg, RoutineName) return - end if - end if - DstInputData%fromSCglob = SrcInputData%fromSCglob - end if - call MeshCopy(SrcInputData%PtfmMotionMesh, DstInputData%PtfmMotionMesh, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcInputData%BStCMotionMesh)) then - LB(1:2) = lbound(SrcInputData%BStCMotionMesh) - UB(1:2) = ubound(SrcInputData%BStCMotionMesh) - if (.not. allocated(DstInputData%BStCMotionMesh)) then - allocate(DstInputData%BStCMotionMesh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + end if + end if + DstOutputData%CableDeltaLdot = SrcOutputData%CableDeltaLdot + end if + if (allocated(SrcOutputData%BStCLoadMesh)) then + LB(1:2) = lbound(SrcOutputData%BStCLoadMesh) + UB(1:2) = ubound(SrcOutputData%BStCLoadMesh) + if (.not. allocated(DstOutputData%BStCLoadMesh)) then + allocate(DstOutputData%BStCLoadMesh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BStCMotionMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BStCLoadMesh.', ErrStat, ErrMsg, RoutineName) return end if end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call MeshCopy(SrcInputData%BStCMotionMesh(i1,i2), DstInputData%BStCMotionMesh(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + call MeshCopy(SrcOutputData%BStCLoadMesh(i1,i2), DstOutputData%BStCLoadMesh(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end do end if - if (allocated(SrcInputData%NStCMotionMesh)) then - LB(1:1) = lbound(SrcInputData%NStCMotionMesh) - UB(1:1) = ubound(SrcInputData%NStCMotionMesh) - if (.not. allocated(DstInputData%NStCMotionMesh)) then - allocate(DstInputData%NStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%NStCLoadMesh)) then + LB(1:1) = lbound(SrcOutputData%NStCLoadMesh) + UB(1:1) = ubound(SrcOutputData%NStCLoadMesh) + if (.not. allocated(DstOutputData%NStCLoadMesh)) then + allocate(DstOutputData%NStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%NStCMotionMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%NStCLoadMesh.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MeshCopy(SrcInputData%NStCMotionMesh(i1), DstInputData%NStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call MeshCopy(SrcOutputData%NStCLoadMesh(i1), DstOutputData%NStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcInputData%TStCMotionMesh)) then - LB(1:1) = lbound(SrcInputData%TStCMotionMesh) - UB(1:1) = ubound(SrcInputData%TStCMotionMesh) - if (.not. allocated(DstInputData%TStCMotionMesh)) then - allocate(DstInputData%TStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%TStCLoadMesh)) then + LB(1:1) = lbound(SrcOutputData%TStCLoadMesh) + UB(1:1) = ubound(SrcOutputData%TStCLoadMesh) + if (.not. allocated(DstOutputData%TStCLoadMesh)) then + allocate(DstOutputData%TStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%TStCMotionMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TStCLoadMesh.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MeshCopy(SrcInputData%TStCMotionMesh(i1), DstInputData%TStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call MeshCopy(SrcOutputData%TStCLoadMesh(i1), DstOutputData%TStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcInputData%SStCMotionMesh)) then - LB(1:1) = lbound(SrcInputData%SStCMotionMesh) - UB(1:1) = ubound(SrcInputData%SStCMotionMesh) - if (.not. allocated(DstInputData%SStCMotionMesh)) then - allocate(DstInputData%SStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%SStCLoadMesh)) then + LB(1:1) = lbound(SrcOutputData%SStCLoadMesh) + UB(1:1) = ubound(SrcOutputData%SStCLoadMesh) + if (.not. allocated(DstOutputData%SStCLoadMesh)) then + allocate(DstOutputData%SStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%SStCMotionMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SStCLoadMesh.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MeshCopy(SrcInputData%SStCMotionMesh(i1), DstInputData%SStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call MeshCopy(SrcOutputData%SStCLoadMesh(i1), DstOutputData%SStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if - if (allocated(SrcInputData%LidSpeed)) then - LB(1:1) = lbound(SrcInputData%LidSpeed) - UB(1:1) = ubound(SrcInputData%LidSpeed) - if (.not. allocated(DstInputData%LidSpeed)) then - allocate(DstInputData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%LidSpeed.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInputData%LidSpeed = SrcInputData%LidSpeed - end if - if (allocated(SrcInputData%MsrPositionsX)) then - LB(1:1) = lbound(SrcInputData%MsrPositionsX) - UB(1:1) = ubound(SrcInputData%MsrPositionsX) - if (.not. allocated(DstInputData%MsrPositionsX)) then - allocate(DstInputData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsX.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInputData%MsrPositionsX = SrcInputData%MsrPositionsX - end if - if (allocated(SrcInputData%MsrPositionsY)) then - LB(1:1) = lbound(SrcInputData%MsrPositionsY) - UB(1:1) = ubound(SrcInputData%MsrPositionsY) - if (.not. allocated(DstInputData%MsrPositionsY)) then - allocate(DstInputData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsY.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInputData%MsrPositionsY = SrcInputData%MsrPositionsY - end if - if (allocated(SrcInputData%MsrPositionsZ)) then - LB(1:1) = lbound(SrcInputData%MsrPositionsZ) - UB(1:1) = ubound(SrcInputData%MsrPositionsZ) - if (.not. allocated(DstInputData%MsrPositionsZ)) then - allocate(DstInputData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%toSC)) then + LB(1:1) = lbound(SrcOutputData%toSC) + UB(1:1) = ubound(SrcOutputData%toSC) + if (.not. allocated(DstOutputData%toSC)) then + allocate(DstOutputData%toSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsZ.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%toSC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputData%MsrPositionsZ = SrcInputData%MsrPositionsZ + DstOutputData%toSC = SrcOutputData%toSC end if end subroutine -subroutine SrvD_DestroyInput(InputData, ErrStat, ErrMsg) - type(SrvD_InputType), intent(inout) :: InputData +subroutine SrvD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SrvD_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg integer(B4Ki) :: i1, i2 integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SrvD_DestroyInput' + character(*), parameter :: RoutineName = 'SrvD_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' - if (allocated(InputData%BlPitch)) then - deallocate(InputData%BlPitch) - end if - if (allocated(InputData%ExternalBlPitchCom)) then - deallocate(InputData%ExternalBlPitchCom) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) end if - if (allocated(InputData%ExternalBlAirfoilCom)) then - deallocate(InputData%ExternalBlAirfoilCom) + if (allocated(OutputData%BlPitchCom)) then + deallocate(OutputData%BlPitchCom) end if - if (allocated(InputData%ExternalCableDeltaL)) then - deallocate(InputData%ExternalCableDeltaL) + if (allocated(OutputData%BlAirfoilCom)) then + deallocate(OutputData%BlAirfoilCom) end if - if (allocated(InputData%ExternalCableDeltaLdot)) then - deallocate(InputData%ExternalCableDeltaLdot) + if (allocated(OutputData%TBDrCon)) then + deallocate(OutputData%TBDrCon) end if - if (allocated(InputData%fromSC)) then - deallocate(InputData%fromSC) + if (allocated(OutputData%CableDeltaL)) then + deallocate(OutputData%CableDeltaL) end if - if (allocated(InputData%fromSCglob)) then - deallocate(InputData%fromSCglob) + if (allocated(OutputData%CableDeltaLdot)) then + deallocate(OutputData%CableDeltaLdot) end if - call MeshDestroy( InputData%PtfmMotionMesh, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(InputData%BStCMotionMesh)) then - LB(1:2) = lbound(InputData%BStCMotionMesh) - UB(1:2) = ubound(InputData%BStCMotionMesh) + if (allocated(OutputData%BStCLoadMesh)) then + LB(1:2) = lbound(OutputData%BStCLoadMesh) + UB(1:2) = ubound(OutputData%BStCLoadMesh) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call MeshDestroy( InputData%BStCMotionMesh(i1,i2), ErrStat2, ErrMsg2) + call MeshDestroy( OutputData%BStCLoadMesh(i1,i2), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do end do - deallocate(InputData%BStCMotionMesh) + deallocate(OutputData%BStCLoadMesh) end if - if (allocated(InputData%NStCMotionMesh)) then - LB(1:1) = lbound(InputData%NStCMotionMesh) - UB(1:1) = ubound(InputData%NStCMotionMesh) + if (allocated(OutputData%NStCLoadMesh)) then + LB(1:1) = lbound(OutputData%NStCLoadMesh) + UB(1:1) = ubound(OutputData%NStCLoadMesh) do i1 = LB(1), UB(1) - call MeshDestroy( InputData%NStCMotionMesh(i1), ErrStat2, ErrMsg2) + call MeshDestroy( OutputData%NStCLoadMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(InputData%NStCMotionMesh) + deallocate(OutputData%NStCLoadMesh) end if - if (allocated(InputData%TStCMotionMesh)) then - LB(1:1) = lbound(InputData%TStCMotionMesh) - UB(1:1) = ubound(InputData%TStCMotionMesh) + if (allocated(OutputData%TStCLoadMesh)) then + LB(1:1) = lbound(OutputData%TStCLoadMesh) + UB(1:1) = ubound(OutputData%TStCLoadMesh) do i1 = LB(1), UB(1) - call MeshDestroy( InputData%TStCMotionMesh(i1), ErrStat2, ErrMsg2) + call MeshDestroy( OutputData%TStCLoadMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(InputData%TStCMotionMesh) + deallocate(OutputData%TStCLoadMesh) end if - if (allocated(InputData%SStCMotionMesh)) then - LB(1:1) = lbound(InputData%SStCMotionMesh) - UB(1:1) = ubound(InputData%SStCMotionMesh) + if (allocated(OutputData%SStCLoadMesh)) then + LB(1:1) = lbound(OutputData%SStCLoadMesh) + UB(1:1) = ubound(OutputData%SStCLoadMesh) do i1 = LB(1), UB(1) - call MeshDestroy( InputData%SStCMotionMesh(i1), ErrStat2, ErrMsg2) + call MeshDestroy( OutputData%SStCLoadMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(InputData%SStCMotionMesh) - end if - if (allocated(InputData%LidSpeed)) then - deallocate(InputData%LidSpeed) - end if - if (allocated(InputData%MsrPositionsX)) then - deallocate(InputData%MsrPositionsX) - end if - if (allocated(InputData%MsrPositionsY)) then - deallocate(InputData%MsrPositionsY) + deallocate(OutputData%SStCLoadMesh) end if - if (allocated(InputData%MsrPositionsZ)) then - deallocate(InputData%MsrPositionsZ) + if (allocated(OutputData%toSC)) then + deallocate(OutputData%toSC) end if end subroutine -subroutine SrvD_PackInput(RF, Indata) +subroutine SrvD_PackOutput(RF, Indata) type(RegFile), intent(inout) :: RF - type(SrvD_InputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SrvD_PackInput' + type(SrvD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackOutput' integer(B4Ki) :: i1, i2 integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%BlPitch) - call RegPack(RF, InData%Yaw) - call RegPack(RF, InData%YawRate) - call RegPack(RF, InData%LSS_Spd) - call RegPack(RF, InData%HSS_Spd) - call RegPack(RF, InData%RotSpeed) - call RegPack(RF, InData%ExternalYawPosCom) - call RegPack(RF, InData%ExternalYawRateCom) - call RegPackAlloc(RF, InData%ExternalBlPitchCom) - call RegPack(RF, InData%ExternalGenTrq) - call RegPack(RF, InData%ExternalElecPwr) - call RegPack(RF, InData%ExternalHSSBrFrac) - call RegPackAlloc(RF, InData%ExternalBlAirfoilCom) - call RegPackAlloc(RF, InData%ExternalCableDeltaL) - call RegPackAlloc(RF, InData%ExternalCableDeltaLdot) - call RegPack(RF, InData%TwrAccel) - call RegPack(RF, InData%YawErr) - call RegPack(RF, InData%WindDir) - call RegPack(RF, InData%RootMyc) - call RegPack(RF, InData%YawBrTAxp) - call RegPack(RF, InData%YawBrTAyp) - call RegPack(RF, InData%LSSTipPxa) - call RegPack(RF, InData%RootMxc) - call RegPack(RF, InData%LSSTipMxa) - call RegPack(RF, InData%LSSTipMya) - call RegPack(RF, InData%LSSTipMza) - call RegPack(RF, InData%LSSTipMys) - call RegPack(RF, InData%LSSTipMzs) - call RegPack(RF, InData%YawBrMyn) - call RegPack(RF, InData%YawBrMzn) - call RegPack(RF, InData%NcIMURAxs) - call RegPack(RF, InData%NcIMURAys) - call RegPack(RF, InData%NcIMURAzs) - call RegPack(RF, InData%RotPwr) - call RegPack(RF, InData%HorWindV) - call RegPack(RF, InData%YawAngle) - call RegPack(RF, InData%LSShftFxa) - call RegPack(RF, InData%LSShftFys) - call RegPack(RF, InData%LSShftFzs) - call RegPackAlloc(RF, InData%fromSC) - call RegPackAlloc(RF, InData%fromSCglob) - call MeshPack(RF, InData%PtfmMotionMesh) - call RegPack(RF, allocated(InData%BStCMotionMesh)) - if (allocated(InData%BStCMotionMesh)) then - call RegPackBounds(RF, 2, lbound(InData%BStCMotionMesh), ubound(InData%BStCMotionMesh)) - LB(1:2) = lbound(InData%BStCMotionMesh) - UB(1:2) = ubound(InData%BStCMotionMesh) + call RegPackAlloc(RF, InData%WriteOutput) + call RegPackAlloc(RF, InData%BlPitchCom) + call RegPackAlloc(RF, InData%BlAirfoilCom) + call RegPack(RF, InData%YawMom) + call RegPack(RF, InData%YawPosCom) + call RegPack(RF, InData%YawRateCom) + call RegPack(RF, InData%GenTrq) + call RegPack(RF, InData%HSSBrTrqC) + call RegPack(RF, InData%ElecPwr) + call RegPackAlloc(RF, InData%TBDrCon) + call RegPackAlloc(RF, InData%CableDeltaL) + call RegPackAlloc(RF, InData%CableDeltaLdot) + call RegPack(RF, allocated(InData%BStCLoadMesh)) + if (allocated(InData%BStCLoadMesh)) then + call RegPackBounds(RF, 2, lbound(InData%BStCLoadMesh), ubound(InData%BStCLoadMesh)) + LB(1:2) = lbound(InData%BStCLoadMesh) + UB(1:2) = ubound(InData%BStCLoadMesh) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%BStCMotionMesh(i1,i2)) + call MeshPack(RF, InData%BStCLoadMesh(i1,i2)) end do end do end if - call RegPack(RF, allocated(InData%NStCMotionMesh)) - if (allocated(InData%NStCMotionMesh)) then - call RegPackBounds(RF, 1, lbound(InData%NStCMotionMesh), ubound(InData%NStCMotionMesh)) - LB(1:1) = lbound(InData%NStCMotionMesh) - UB(1:1) = ubound(InData%NStCMotionMesh) + call RegPack(RF, allocated(InData%NStCLoadMesh)) + if (allocated(InData%NStCLoadMesh)) then + call RegPackBounds(RF, 1, lbound(InData%NStCLoadMesh), ubound(InData%NStCLoadMesh)) + LB(1:1) = lbound(InData%NStCLoadMesh) + UB(1:1) = ubound(InData%NStCLoadMesh) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%NStCMotionMesh(i1)) + call MeshPack(RF, InData%NStCLoadMesh(i1)) end do end if - call RegPack(RF, allocated(InData%TStCMotionMesh)) - if (allocated(InData%TStCMotionMesh)) then - call RegPackBounds(RF, 1, lbound(InData%TStCMotionMesh), ubound(InData%TStCMotionMesh)) - LB(1:1) = lbound(InData%TStCMotionMesh) - UB(1:1) = ubound(InData%TStCMotionMesh) + call RegPack(RF, allocated(InData%TStCLoadMesh)) + if (allocated(InData%TStCLoadMesh)) then + call RegPackBounds(RF, 1, lbound(InData%TStCLoadMesh), ubound(InData%TStCLoadMesh)) + LB(1:1) = lbound(InData%TStCLoadMesh) + UB(1:1) = ubound(InData%TStCLoadMesh) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%TStCMotionMesh(i1)) + call MeshPack(RF, InData%TStCLoadMesh(i1)) end do end if - call RegPack(RF, allocated(InData%SStCMotionMesh)) - if (allocated(InData%SStCMotionMesh)) then - call RegPackBounds(RF, 1, lbound(InData%SStCMotionMesh), ubound(InData%SStCMotionMesh)) - LB(1:1) = lbound(InData%SStCMotionMesh) - UB(1:1) = ubound(InData%SStCMotionMesh) + call RegPack(RF, allocated(InData%SStCLoadMesh)) + if (allocated(InData%SStCLoadMesh)) then + call RegPackBounds(RF, 1, lbound(InData%SStCLoadMesh), ubound(InData%SStCLoadMesh)) + LB(1:1) = lbound(InData%SStCLoadMesh) + UB(1:1) = ubound(InData%SStCLoadMesh) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%SStCMotionMesh(i1)) + call MeshPack(RF, InData%SStCLoadMesh(i1)) end do end if - call RegPackAlloc(RF, InData%LidSpeed) - call RegPackAlloc(RF, InData%MsrPositionsX) - call RegPackAlloc(RF, InData%MsrPositionsY) - call RegPackAlloc(RF, InData%MsrPositionsZ) + call RegPackAlloc(RF, InData%toSC) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SrvD_UnPackInput(RF, OutData) +subroutine SrvD_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF - type(SrvD_InputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SrvD_UnPackInput' + type(SrvD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackOutput' integer(B4Ki) :: i1, i2 integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%BlPitch); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Yaw); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawRate); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSS_Spd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%HSS_Spd); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ExternalYawPosCom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ExternalYawRateCom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ExternalBlPitchCom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ExternalGenTrq); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ExternalElecPwr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ExternalHSSBrFrac); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ExternalBlAirfoilCom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ExternalCableDeltaL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ExternalCableDeltaLdot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TwrAccel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawErr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%WindDir); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RootMyc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawBrTAxp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawBrTAyp); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSSTipPxa); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RootMxc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSSTipMxa); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSSTipMya); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSSTipMza); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSSTipMys); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSSTipMzs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawBrMyn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawBrMzn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NcIMURAxs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NcIMURAys); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NcIMURAzs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RotPwr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%HorWindV); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawAngle); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSShftFxa); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSShftFys); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LSShftFzs); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%fromSC); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%fromSCglob); if (RegCheckErr(RF, RoutineName)) return - call MeshUnpack(RF, OutData%PtfmMotionMesh) ! PtfmMotionMesh - if (allocated(OutData%BStCMotionMesh)) deallocate(OutData%BStCMotionMesh) + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitchCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlAirfoilCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawMom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawPosCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawRateCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrTrqC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ElecPwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TBDrCon); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CableDeltaL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CableDeltaLdot); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BStCLoadMesh)) deallocate(OutData%BStCLoadMesh) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BStCMotionMesh(LB(1):UB(1),LB(2):UB(2)),stat=stat) + allocate(OutData%BStCLoadMesh(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%BStCMotionMesh(i1,i2)) ! BStCMotionMesh + call MeshUnpack(RF, OutData%BStCLoadMesh(i1,i2)) ! BStCLoadMesh end do end do end if - if (allocated(OutData%NStCMotionMesh)) deallocate(OutData%NStCMotionMesh) + if (allocated(OutData%NStCLoadMesh)) deallocate(OutData%NStCLoadMesh) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%NStCMotionMesh(LB(1):UB(1)),stat=stat) + allocate(OutData%NStCLoadMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%NStCMotionMesh(i1)) ! NStCMotionMesh + call MeshUnpack(RF, OutData%NStCLoadMesh(i1)) ! NStCLoadMesh end do end if - if (allocated(OutData%TStCMotionMesh)) deallocate(OutData%TStCMotionMesh) + if (allocated(OutData%TStCLoadMesh)) deallocate(OutData%TStCLoadMesh) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%TStCMotionMesh(LB(1):UB(1)),stat=stat) + allocate(OutData%TStCLoadMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%TStCMotionMesh(i1)) ! TStCMotionMesh + call MeshUnpack(RF, OutData%TStCLoadMesh(i1)) ! TStCLoadMesh end do end if - if (allocated(OutData%SStCMotionMesh)) deallocate(OutData%SStCMotionMesh) + if (allocated(OutData%SStCLoadMesh)) deallocate(OutData%SStCLoadMesh) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%SStCMotionMesh(LB(1):UB(1)),stat=stat) + allocate(OutData%SStCLoadMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%SStCMotionMesh(i1)) ! SStCMotionMesh + call MeshUnpack(RF, OutData%SStCLoadMesh(i1)) ! SStCLoadMesh + end do + end if + call RegUnpackAlloc(RF, OutData%toSC); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_MiscVarType), intent(inout) :: SrcMiscData + type(SrvD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%LastTimeCalled = SrcMiscData%LastTimeCalled + call SrvD_CopyBladedDLLType(SrcMiscData%dll_data, DstMiscData%dll_data, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%FirstWarn = SrcMiscData%FirstWarn + DstMiscData%LastTimeFiltered = SrcMiscData%LastTimeFiltered + if (allocated(SrcMiscData%xd_BlPitchFilter)) then + LB(1:1) = lbound(SrcMiscData%xd_BlPitchFilter) + UB(1:1) = ubound(SrcMiscData%xd_BlPitchFilter) + if (.not. allocated(DstMiscData%xd_BlPitchFilter)) then + allocate(DstMiscData%xd_BlPitchFilter(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%xd_BlPitchFilter.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%xd_BlPitchFilter = SrcMiscData%xd_BlPitchFilter + end if + if (allocated(SrcMiscData%BStC)) then + LB(1:1) = lbound(SrcMiscData%BStC) + UB(1:1) = ubound(SrcMiscData%BStC) + if (.not. allocated(DstMiscData%BStC)) then + allocate(DstMiscData%BStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyMisc(SrcMiscData%BStC(i1), DstMiscData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%NStC)) then + LB(1:1) = lbound(SrcMiscData%NStC) + UB(1:1) = ubound(SrcMiscData%NStC) + if (.not. allocated(DstMiscData%NStC)) then + allocate(DstMiscData%NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyMisc(SrcMiscData%NStC(i1), DstMiscData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%TStC)) then + LB(1:1) = lbound(SrcMiscData%TStC) + UB(1:1) = ubound(SrcMiscData%TStC) + if (.not. allocated(DstMiscData%TStC)) then + allocate(DstMiscData%TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyMisc(SrcMiscData%TStC(i1), DstMiscData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%SStC)) then + LB(1:1) = lbound(SrcMiscData%SStC) + UB(1:1) = ubound(SrcMiscData%SStC) + if (.not. allocated(DstMiscData%SStC)) then + allocate(DstMiscData%SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyMisc(SrcMiscData%SStC(i1), DstMiscData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%u_BStC)) then + LB(1:2) = lbound(SrcMiscData%u_BStC) + UB(1:2) = ubound(SrcMiscData%u_BStC) + if (.not. allocated(DstMiscData%u_BStC)) then + allocate(DstMiscData%u_BStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_CopyInput(SrcMiscData%u_BStC(i1,i2), DstMiscData%u_BStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end do end if - call RegUnpackAlloc(RF, OutData%LidSpeed); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%MsrPositionsX); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%MsrPositionsY); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%MsrPositionsZ); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) - type(SrvD_OutputType), intent(inout) :: SrcOutputData - type(SrvD_OutputType), intent(inout) :: DstOutputData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SrvD_CopyOutput' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) - if (.not. allocated(DstOutputData%WriteOutput)) then - allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%u_NStC)) then + LB(1:2) = lbound(SrcMiscData%u_NStC) + UB(1:2) = ubound(SrcMiscData%u_NStC) + if (.not. allocated(DstMiscData%u_NStC)) then + allocate(DstMiscData%u_NStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_NStC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%WriteOutput = SrcOutputData%WriteOutput + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_CopyInput(SrcMiscData%u_NStC(i1,i2), DstMiscData%u_NStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do end if - if (allocated(SrcOutputData%BlPitchCom)) then - LB(1:1) = lbound(SrcOutputData%BlPitchCom) - UB(1:1) = ubound(SrcOutputData%BlPitchCom) - if (.not. allocated(DstOutputData%BlPitchCom)) then - allocate(DstOutputData%BlPitchCom(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%u_TStC)) then + LB(1:2) = lbound(SrcMiscData%u_TStC) + UB(1:2) = ubound(SrcMiscData%u_TStC) + if (.not. allocated(DstMiscData%u_TStC)) then + allocate(DstMiscData%u_TStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlPitchCom.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_TStC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%BlPitchCom = SrcOutputData%BlPitchCom + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_CopyInput(SrcMiscData%u_TStC(i1,i2), DstMiscData%u_TStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do end if - if (allocated(SrcOutputData%BlAirfoilCom)) then - LB(1:1) = lbound(SrcOutputData%BlAirfoilCom) - UB(1:1) = ubound(SrcOutputData%BlAirfoilCom) - if (.not. allocated(DstOutputData%BlAirfoilCom)) then - allocate(DstOutputData%BlAirfoilCom(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%u_SStC)) then + LB(1:2) = lbound(SrcMiscData%u_SStC) + UB(1:2) = ubound(SrcMiscData%u_SStC) + if (.not. allocated(DstMiscData%u_SStC)) then + allocate(DstMiscData%u_SStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlAirfoilCom.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_SStC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%BlAirfoilCom = SrcOutputData%BlAirfoilCom + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_CopyInput(SrcMiscData%u_SStC(i1,i2), DstMiscData%u_SStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do end if - DstOutputData%YawMom = SrcOutputData%YawMom - DstOutputData%YawPosCom = SrcOutputData%YawPosCom - DstOutputData%YawRateCom = SrcOutputData%YawRateCom - DstOutputData%GenTrq = SrcOutputData%GenTrq - DstOutputData%HSSBrTrqC = SrcOutputData%HSSBrTrqC - DstOutputData%ElecPwr = SrcOutputData%ElecPwr - if (allocated(SrcOutputData%TBDrCon)) then - LB(1:1) = lbound(SrcOutputData%TBDrCon) - UB(1:1) = ubound(SrcOutputData%TBDrCon) - if (.not. allocated(DstOutputData%TBDrCon)) then - allocate(DstOutputData%TBDrCon(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%y_BStC)) then + LB(1:1) = lbound(SrcMiscData%y_BStC) + UB(1:1) = ubound(SrcMiscData%y_BStC) + if (.not. allocated(DstMiscData%y_BStC)) then + allocate(DstMiscData%y_BStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TBDrCon.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_BStC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%TBDrCon = SrcOutputData%TBDrCon + do i1 = LB(1), UB(1) + call StC_CopyOutput(SrcMiscData%y_BStC(i1), DstMiscData%y_BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcOutputData%CableDeltaL)) then - LB(1:1) = lbound(SrcOutputData%CableDeltaL) - UB(1:1) = ubound(SrcOutputData%CableDeltaL) - if (.not. allocated(DstOutputData%CableDeltaL)) then - allocate(DstOutputData%CableDeltaL(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%y_NStC)) then + LB(1:1) = lbound(SrcMiscData%y_NStC) + UB(1:1) = ubound(SrcMiscData%y_NStC) + if (.not. allocated(DstMiscData%y_NStC)) then + allocate(DstMiscData%y_NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CableDeltaL.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_NStC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%CableDeltaL = SrcOutputData%CableDeltaL + do i1 = LB(1), UB(1) + call StC_CopyOutput(SrcMiscData%y_NStC(i1), DstMiscData%y_NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcOutputData%CableDeltaLdot)) then - LB(1:1) = lbound(SrcOutputData%CableDeltaLdot) - UB(1:1) = ubound(SrcOutputData%CableDeltaLdot) - if (.not. allocated(DstOutputData%CableDeltaLdot)) then - allocate(DstOutputData%CableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%y_TStC)) then + LB(1:1) = lbound(SrcMiscData%y_TStC) + UB(1:1) = ubound(SrcMiscData%y_TStC) + if (.not. allocated(DstMiscData%y_TStC)) then + allocate(DstMiscData%y_TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CableDeltaLdot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_TStC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%CableDeltaLdot = SrcOutputData%CableDeltaLdot + do i1 = LB(1), UB(1) + call StC_CopyOutput(SrcMiscData%y_TStC(i1), DstMiscData%y_TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcOutputData%BStCLoadMesh)) then - LB(1:2) = lbound(SrcOutputData%BStCLoadMesh) - UB(1:2) = ubound(SrcOutputData%BStCLoadMesh) - if (.not. allocated(DstOutputData%BStCLoadMesh)) then - allocate(DstOutputData%BStCLoadMesh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcMiscData%y_SStC)) then + LB(1:1) = lbound(SrcMiscData%y_SStC) + UB(1:1) = ubound(SrcMiscData%y_SStC) + if (.not. allocated(DstMiscData%y_SStC)) then + allocate(DstMiscData%y_SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_SStC.', ErrStat, ErrMsg, RoutineName) return end if end if + do i1 = LB(1), UB(1) + call StC_CopyOutput(SrcMiscData%y_SStC(i1), DstMiscData%y_SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call SrvD_CopyModuleMapType(SrcMiscData%SrvD_MeshMap, DstMiscData%SrvD_MeshMap, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%PrevTstepNcall = SrcMiscData%PrevTstepNcall + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SrvD_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SrvD_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SrvD_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SrvD_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SrvD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call SrvD_DestroyBladedDLLType(MiscData%dll_data, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%xd_BlPitchFilter)) then + deallocate(MiscData%xd_BlPitchFilter) + end if + if (allocated(MiscData%BStC)) then + LB(1:1) = lbound(MiscData%BStC) + UB(1:1) = ubound(MiscData%BStC) + do i1 = LB(1), UB(1) + call StC_DestroyMisc(MiscData%BStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%BStC) + end if + if (allocated(MiscData%NStC)) then + LB(1:1) = lbound(MiscData%NStC) + UB(1:1) = ubound(MiscData%NStC) + do i1 = LB(1), UB(1) + call StC_DestroyMisc(MiscData%NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%NStC) + end if + if (allocated(MiscData%TStC)) then + LB(1:1) = lbound(MiscData%TStC) + UB(1:1) = ubound(MiscData%TStC) + do i1 = LB(1), UB(1) + call StC_DestroyMisc(MiscData%TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%TStC) + end if + if (allocated(MiscData%SStC)) then + LB(1:1) = lbound(MiscData%SStC) + UB(1:1) = ubound(MiscData%SStC) + do i1 = LB(1), UB(1) + call StC_DestroyMisc(MiscData%SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%SStC) + end if + if (allocated(MiscData%u_BStC)) then + LB(1:2) = lbound(MiscData%u_BStC) + UB(1:2) = ubound(MiscData%u_BStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_DestroyInput(MiscData%u_BStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(MiscData%u_BStC) + end if + if (allocated(MiscData%u_NStC)) then + LB(1:2) = lbound(MiscData%u_NStC) + UB(1:2) = ubound(MiscData%u_NStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_DestroyInput(MiscData%u_NStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(MiscData%u_NStC) + end if + if (allocated(MiscData%u_TStC)) then + LB(1:2) = lbound(MiscData%u_TStC) + UB(1:2) = ubound(MiscData%u_TStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_DestroyInput(MiscData%u_TStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(MiscData%u_TStC) + end if + if (allocated(MiscData%u_SStC)) then + LB(1:2) = lbound(MiscData%u_SStC) + UB(1:2) = ubound(MiscData%u_SStC) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%BStCLoadMesh(i1,i2), DstOutputData%BStCLoadMesh(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + call StC_DestroyInput(MiscData%u_SStC(i1,i2), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end do end do + deallocate(MiscData%u_SStC) end if - if (allocated(SrcOutputData%NStCLoadMesh)) then - LB(1:1) = lbound(SrcOutputData%NStCLoadMesh) - UB(1:1) = ubound(SrcOutputData%NStCLoadMesh) - if (.not. allocated(DstOutputData%NStCLoadMesh)) then - allocate(DstOutputData%NStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%NStCLoadMesh.', ErrStat, ErrMsg, RoutineName) - return - end if - end if + if (allocated(MiscData%y_BStC)) then + LB(1:1) = lbound(MiscData%y_BStC) + UB(1:1) = ubound(MiscData%y_BStC) do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%NStCLoadMesh(i1), DstOutputData%NStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call StC_DestroyOutput(MiscData%y_BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end do + deallocate(MiscData%y_BStC) end if - if (allocated(SrcOutputData%TStCLoadMesh)) then - LB(1:1) = lbound(SrcOutputData%TStCLoadMesh) - UB(1:1) = ubound(SrcOutputData%TStCLoadMesh) - if (.not. allocated(DstOutputData%TStCLoadMesh)) then - allocate(DstOutputData%TStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TStCLoadMesh.', ErrStat, ErrMsg, RoutineName) - return - end if - end if + if (allocated(MiscData%y_NStC)) then + LB(1:1) = lbound(MiscData%y_NStC) + UB(1:1) = ubound(MiscData%y_NStC) do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%TStCLoadMesh(i1), DstOutputData%TStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call StC_DestroyOutput(MiscData%y_NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end do + deallocate(MiscData%y_NStC) end if - if (allocated(SrcOutputData%SStCLoadMesh)) then - LB(1:1) = lbound(SrcOutputData%SStCLoadMesh) - UB(1:1) = ubound(SrcOutputData%SStCLoadMesh) - if (.not. allocated(DstOutputData%SStCLoadMesh)) then - allocate(DstOutputData%SStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SStCLoadMesh.', ErrStat, ErrMsg, RoutineName) - return - end if - end if + if (allocated(MiscData%y_TStC)) then + LB(1:1) = lbound(MiscData%y_TStC) + UB(1:1) = ubound(MiscData%y_TStC) do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%SStCLoadMesh(i1), DstOutputData%SStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call StC_DestroyOutput(MiscData%y_TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end do + deallocate(MiscData%y_TStC) end if - if (allocated(SrcOutputData%toSC)) then - LB(1:1) = lbound(SrcOutputData%toSC) - UB(1:1) = ubound(SrcOutputData%toSC) - if (.not. allocated(DstOutputData%toSC)) then - allocate(DstOutputData%toSC(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%toSC.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstOutputData%toSC = SrcOutputData%toSC + if (allocated(MiscData%y_SStC)) then + LB(1:1) = lbound(MiscData%y_SStC) + UB(1:1) = ubound(MiscData%y_SStC) + do i1 = LB(1), UB(1) + call StC_DestroyOutput(MiscData%y_SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%y_SStC) end if + call SrvD_DestroyModuleMapType(MiscData%SrvD_MeshMap, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SrvD_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SrvD_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SrvD_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SrvD_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine SrvD_DestroyOutput(OutputData, ErrStat, ErrMsg) - type(SrvD_OutputType), intent(inout) :: OutputData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg +subroutine SrvD_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SrvD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackMisc' integer(B4Ki) :: i1, i2 integer(B4Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SrvD_DestroyOutput' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(OutputData%WriteOutput)) then - deallocate(OutputData%WriteOutput) - end if - if (allocated(OutputData%BlPitchCom)) then - deallocate(OutputData%BlPitchCom) - end if - if (allocated(OutputData%BlAirfoilCom)) then - deallocate(OutputData%BlAirfoilCom) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%LastTimeCalled) + call SrvD_PackBladedDLLType(RF, InData%dll_data) + call RegPack(RF, InData%FirstWarn) + call RegPack(RF, InData%LastTimeFiltered) + call RegPackAlloc(RF, InData%xd_BlPitchFilter) + call RegPack(RF, allocated(InData%BStC)) + if (allocated(InData%BStC)) then + call RegPackBounds(RF, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) + do i1 = LB(1), UB(1) + call StC_PackMisc(RF, InData%BStC(i1)) + end do end if - if (allocated(OutputData%TBDrCon)) then - deallocate(OutputData%TBDrCon) + call RegPack(RF, allocated(InData%NStC)) + if (allocated(InData%NStC)) then + call RegPackBounds(RF, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) + do i1 = LB(1), UB(1) + call StC_PackMisc(RF, InData%NStC(i1)) + end do end if - if (allocated(OutputData%CableDeltaL)) then - deallocate(OutputData%CableDeltaL) + call RegPack(RF, allocated(InData%TStC)) + if (allocated(InData%TStC)) then + call RegPackBounds(RF, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) + do i1 = LB(1), UB(1) + call StC_PackMisc(RF, InData%TStC(i1)) + end do end if - if (allocated(OutputData%CableDeltaLdot)) then - deallocate(OutputData%CableDeltaLdot) + call RegPack(RF, allocated(InData%SStC)) + if (allocated(InData%SStC)) then + call RegPackBounds(RF, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) + do i1 = LB(1), UB(1) + call StC_PackMisc(RF, InData%SStC(i1)) + end do end if - if (allocated(OutputData%BStCLoadMesh)) then - LB(1:2) = lbound(OutputData%BStCLoadMesh) - UB(1:2) = ubound(OutputData%BStCLoadMesh) + call RegPack(RF, allocated(InData%u_BStC)) + if (allocated(InData%u_BStC)) then + call RegPackBounds(RF, 2, lbound(InData%u_BStC), ubound(InData%u_BStC)) + LB(1:2) = lbound(InData%u_BStC) + UB(1:2) = ubound(InData%u_BStC) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%BStCLoadMesh(i1,i2), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call StC_PackInput(RF, InData%u_BStC(i1,i2)) end do end do - deallocate(OutputData%BStCLoadMesh) - end if - if (allocated(OutputData%NStCLoadMesh)) then - LB(1:1) = lbound(OutputData%NStCLoadMesh) - UB(1:1) = ubound(OutputData%NStCLoadMesh) - do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%NStCLoadMesh(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(OutputData%NStCLoadMesh) end if - if (allocated(OutputData%TStCLoadMesh)) then - LB(1:1) = lbound(OutputData%TStCLoadMesh) - UB(1:1) = ubound(OutputData%TStCLoadMesh) - do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%TStCLoadMesh(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call RegPack(RF, allocated(InData%u_NStC)) + if (allocated(InData%u_NStC)) then + call RegPackBounds(RF, 2, lbound(InData%u_NStC), ubound(InData%u_NStC)) + LB(1:2) = lbound(InData%u_NStC) + UB(1:2) = ubound(InData%u_NStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_PackInput(RF, InData%u_NStC(i1,i2)) + end do end do - deallocate(OutputData%TStCLoadMesh) end if - if (allocated(OutputData%SStCLoadMesh)) then - LB(1:1) = lbound(OutputData%SStCLoadMesh) - UB(1:1) = ubound(OutputData%SStCLoadMesh) - do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%SStCLoadMesh(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call RegPack(RF, allocated(InData%u_TStC)) + if (allocated(InData%u_TStC)) then + call RegPackBounds(RF, 2, lbound(InData%u_TStC), ubound(InData%u_TStC)) + LB(1:2) = lbound(InData%u_TStC) + UB(1:2) = ubound(InData%u_TStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_PackInput(RF, InData%u_TStC(i1,i2)) + end do end do - deallocate(OutputData%SStCLoadMesh) - end if - if (allocated(OutputData%toSC)) then - deallocate(OutputData%toSC) end if -end subroutine - -subroutine SrvD_PackOutput(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SrvD_OutputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SrvD_PackOutput' - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) - if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%WriteOutput) - call RegPackAlloc(RF, InData%BlPitchCom) - call RegPackAlloc(RF, InData%BlAirfoilCom) - call RegPack(RF, InData%YawMom) - call RegPack(RF, InData%YawPosCom) - call RegPack(RF, InData%YawRateCom) - call RegPack(RF, InData%GenTrq) - call RegPack(RF, InData%HSSBrTrqC) - call RegPack(RF, InData%ElecPwr) - call RegPackAlloc(RF, InData%TBDrCon) - call RegPackAlloc(RF, InData%CableDeltaL) - call RegPackAlloc(RF, InData%CableDeltaLdot) - call RegPack(RF, allocated(InData%BStCLoadMesh)) - if (allocated(InData%BStCLoadMesh)) then - call RegPackBounds(RF, 2, lbound(InData%BStCLoadMesh), ubound(InData%BStCLoadMesh)) - LB(1:2) = lbound(InData%BStCLoadMesh) - UB(1:2) = ubound(InData%BStCLoadMesh) + call RegPack(RF, allocated(InData%u_SStC)) + if (allocated(InData%u_SStC)) then + call RegPackBounds(RF, 2, lbound(InData%u_SStC), ubound(InData%u_SStC)) + LB(1:2) = lbound(InData%u_SStC) + UB(1:2) = ubound(InData%u_SStC) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%BStCLoadMesh(i1,i2)) + call StC_PackInput(RF, InData%u_SStC(i1,i2)) end do end do end if - call RegPack(RF, allocated(InData%NStCLoadMesh)) - if (allocated(InData%NStCLoadMesh)) then - call RegPackBounds(RF, 1, lbound(InData%NStCLoadMesh), ubound(InData%NStCLoadMesh)) - LB(1:1) = lbound(InData%NStCLoadMesh) - UB(1:1) = ubound(InData%NStCLoadMesh) + call RegPack(RF, allocated(InData%y_BStC)) + if (allocated(InData%y_BStC)) then + call RegPackBounds(RF, 1, lbound(InData%y_BStC), ubound(InData%y_BStC)) + LB(1:1) = lbound(InData%y_BStC) + UB(1:1) = ubound(InData%y_BStC) + do i1 = LB(1), UB(1) + call StC_PackOutput(RF, InData%y_BStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%y_NStC)) + if (allocated(InData%y_NStC)) then + call RegPackBounds(RF, 1, lbound(InData%y_NStC), ubound(InData%y_NStC)) + LB(1:1) = lbound(InData%y_NStC) + UB(1:1) = ubound(InData%y_NStC) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%NStCLoadMesh(i1)) + call StC_PackOutput(RF, InData%y_NStC(i1)) end do end if - call RegPack(RF, allocated(InData%TStCLoadMesh)) - if (allocated(InData%TStCLoadMesh)) then - call RegPackBounds(RF, 1, lbound(InData%TStCLoadMesh), ubound(InData%TStCLoadMesh)) - LB(1:1) = lbound(InData%TStCLoadMesh) - UB(1:1) = ubound(InData%TStCLoadMesh) + call RegPack(RF, allocated(InData%y_TStC)) + if (allocated(InData%y_TStC)) then + call RegPackBounds(RF, 1, lbound(InData%y_TStC), ubound(InData%y_TStC)) + LB(1:1) = lbound(InData%y_TStC) + UB(1:1) = ubound(InData%y_TStC) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%TStCLoadMesh(i1)) + call StC_PackOutput(RF, InData%y_TStC(i1)) end do end if - call RegPack(RF, allocated(InData%SStCLoadMesh)) - if (allocated(InData%SStCLoadMesh)) then - call RegPackBounds(RF, 1, lbound(InData%SStCLoadMesh), ubound(InData%SStCLoadMesh)) - LB(1:1) = lbound(InData%SStCLoadMesh) - UB(1:1) = ubound(InData%SStCLoadMesh) + call RegPack(RF, allocated(InData%y_SStC)) + if (allocated(InData%y_SStC)) then + call RegPackBounds(RF, 1, lbound(InData%y_SStC), ubound(InData%y_SStC)) + LB(1:1) = lbound(InData%y_SStC) + UB(1:1) = ubound(InData%y_SStC) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%SStCLoadMesh(i1)) + call StC_PackOutput(RF, InData%y_SStC(i1)) end do end if - call RegPackAlloc(RF, InData%toSC) + call SrvD_PackModuleMapType(RF, InData%SrvD_MeshMap) + call RegPack(RF, InData%PrevTstepNcall) + call NWTC_Library_PackModJacType(RF, InData%Jac) + call SrvD_PackContState(RF, InData%x_perturb) + call SrvD_PackContState(RF, InData%dxdt_lin) + call SrvD_PackInput(RF, InData%u_perturb) + call SrvD_PackOutput(RF, InData%y_lin) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SrvD_UnPackOutput(RF, OutData) +subroutine SrvD_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF - type(SrvD_OutputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SrvD_UnPackOutput' + type(SrvD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackMisc' integer(B4Ki) :: i1, i2 integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlPitchCom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%BlAirfoilCom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawMom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawPosCom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%YawRateCom); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%GenTrq); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%HSSBrTrqC); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%ElecPwr); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TBDrCon); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%CableDeltaL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%CableDeltaLdot); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%BStCLoadMesh)) deallocate(OutData%BStCLoadMesh) + call RegUnpack(RF, OutData%LastTimeCalled); if (RegCheckErr(RF, RoutineName)) return + call SrvD_UnpackBladedDLLType(RF, OutData%dll_data) ! dll_data + call RegUnpack(RF, OutData%FirstWarn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastTimeFiltered); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%xd_BlPitchFilter); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BStC)) deallocate(OutData%BStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackMisc(RF, OutData%BStC(i1)) ! BStC + end do + end if + if (allocated(OutData%NStC)) deallocate(OutData%NStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackMisc(RF, OutData%NStC(i1)) ! NStC + end do + end if + if (allocated(OutData%TStC)) deallocate(OutData%TStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackMisc(RF, OutData%TStC(i1)) ! TStC + end do + end if + if (allocated(OutData%SStC)) deallocate(OutData%SStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackMisc(RF, OutData%SStC(i1)) ! SStC + end do + end if + if (allocated(OutData%u_BStC)) deallocate(OutData%u_BStC) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%BStCLoadMesh(LB(1):UB(1),LB(2):UB(2)),stat=stat) + allocate(OutData%u_BStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%BStCLoadMesh(i1,i2)) ! BStCLoadMesh + call StC_UnpackInput(RF, OutData%u_BStC(i1,i2)) ! u_BStC end do end do end if - if (allocated(OutData%NStCLoadMesh)) deallocate(OutData%NStCLoadMesh) + if (allocated(OutData%u_NStC)) deallocate(OutData%u_NStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_NStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_UnpackInput(RF, OutData%u_NStC(i1,i2)) ! u_NStC + end do + end do + end if + if (allocated(OutData%u_TStC)) deallocate(OutData%u_TStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_TStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_UnpackInput(RF, OutData%u_TStC(i1,i2)) ! u_TStC + end do + end do + end if + if (allocated(OutData%u_SStC)) deallocate(OutData%u_SStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_SStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_UnpackInput(RF, OutData%u_SStC(i1,i2)) ! u_SStC + end do + end do + end if + if (allocated(OutData%y_BStC)) deallocate(OutData%y_BStC) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%NStCLoadMesh(LB(1):UB(1)),stat=stat) + allocate(OutData%y_BStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%NStCLoadMesh(i1)) ! NStCLoadMesh + call StC_UnpackOutput(RF, OutData%y_BStC(i1)) ! y_BStC end do end if - if (allocated(OutData%TStCLoadMesh)) deallocate(OutData%TStCLoadMesh) + if (allocated(OutData%y_NStC)) deallocate(OutData%y_NStC) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%TStCLoadMesh(LB(1):UB(1)),stat=stat) + allocate(OutData%y_NStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%TStCLoadMesh(i1)) ! TStCLoadMesh + call StC_UnpackOutput(RF, OutData%y_NStC(i1)) ! y_NStC end do end if - if (allocated(OutData%SStCLoadMesh)) deallocate(OutData%SStCLoadMesh) + if (allocated(OutData%y_TStC)) deallocate(OutData%y_TStC) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%SStCLoadMesh(LB(1):UB(1)),stat=stat) + allocate(OutData%y_TStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%SStCLoadMesh(i1)) ! SStCLoadMesh + call StC_UnpackOutput(RF, OutData%y_TStC(i1)) ! y_TStC end do end if - call RegUnpackAlloc(RF, OutData%toSC); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%y_SStC)) deallocate(OutData%y_SStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%y_SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOutput(RF, OutData%y_SStC(i1)) ! y_SStC + end do + end if + call SrvD_UnpackModuleMapType(RF, OutData%SrvD_MeshMap) ! SrvD_MeshMap + call RegUnpack(RF, OutData%PrevTstepNcall); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call SrvD_UnpackContState(RF, OutData%x_perturb) ! x_perturb + call SrvD_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin + call SrvD_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call SrvD_UnpackOutput(RF, OutData%y_lin) ! y_lin end subroutine subroutine SrvD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) @@ -6981,5 +7177,741 @@ SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E y_out%toSC = a1*y1%toSC + a2*y2%toSC + a3*y3%toSC END IF ! check if allocated END SUBROUTINE + +function SrvD_InputMeshPointer(u, DL) result(Mesh) + type(SrvD_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (SrvD_u_PtfmMotionMesh) + Mesh => u%PtfmMotionMesh + case (SrvD_u_BStCMotionMesh) + Mesh => u%BStCMotionMesh(DL%i1, DL%i2) + case (SrvD_u_NStCMotionMesh) + Mesh => u%NStCMotionMesh(DL%i1) + case (SrvD_u_TStCMotionMesh) + Mesh => u%TStCMotionMesh(DL%i1) + case (SrvD_u_SStCMotionMesh) + Mesh => u%SStCMotionMesh(DL%i1) + end select +end function + +function SrvD_OutputMeshPointer(y, DL) result(Mesh) + type(SrvD_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (SrvD_y_BStCLoadMesh) + Mesh => y%BStCLoadMesh(DL%i1, DL%i2) + case (SrvD_y_NStCLoadMesh) + Mesh => y%NStCLoadMesh(DL%i1) + case (SrvD_y_TStCLoadMesh) + Mesh => y%TStCLoadMesh(DL%i1) + case (SrvD_y_SStCLoadMesh) + Mesh => y%SStCLoadMesh(DL%i1) + end select +end function + +subroutine SrvD_VarsPackContState(Vars, x, ValAry) + type(SrvD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SrvD_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine SrvD_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SrvD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SrvD_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case (SrvD_x_BStC_StC_x) + VarVals = x%BStC(DL%i1)%StC_x(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (SrvD_x_NStC_StC_x) + VarVals = x%NStC(DL%i1)%StC_x(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (SrvD_x_TStC_StC_x) + VarVals = x%TStC(DL%i1)%StC_x(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (SrvD_x_SStC_StC_x) + VarVals = x%SStC(DL%i1)%StC_x(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SrvD_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SrvD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SrvD_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine SrvD_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SrvD_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SrvD_x_DummyContState) + x%DummyContState = VarVals(1) ! Scalar + case (SrvD_x_BStC_StC_x) + x%BStC(DL%i1)%StC_x(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (SrvD_x_NStC_StC_x) + x%NStC(DL%i1)%StC_x(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (SrvD_x_TStC_StC_x) + x%TStC(DL%i1)%StC_x(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (SrvD_x_SStC_StC_x) + x%SStC(DL%i1)%StC_x(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + +function SrvD_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SrvD_x_DummyContState) + Name = "x%DummyContState" + case (SrvD_x_BStC_StC_x) + Name = "x%BStC("//trim(Num2LStr(DL%i1))//")%StC_x" + case (SrvD_x_NStC_StC_x) + Name = "x%NStC("//trim(Num2LStr(DL%i1))//")%StC_x" + case (SrvD_x_TStC_StC_x) + Name = "x%TStC("//trim(Num2LStr(DL%i1))//")%StC_x" + case (SrvD_x_SStC_StC_x) + Name = "x%SStC("//trim(Num2LStr(DL%i1))//")%StC_x" + case default + Name = "Unknown Field" + end select +end function + +subroutine SrvD_VarsPackContStateDeriv(Vars, x, ValAry) + type(SrvD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SrvD_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine SrvD_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SrvD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SrvD_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case (SrvD_x_BStC_StC_x) + VarVals = x%BStC(DL%i1)%StC_x(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (SrvD_x_NStC_StC_x) + VarVals = x%NStC(DL%i1)%StC_x(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (SrvD_x_TStC_StC_x) + VarVals = x%TStC(DL%i1)%StC_x(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (SrvD_x_SStC_StC_x) + VarVals = x%SStC(DL%i1)%StC_x(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SrvD_VarsPackConstrState(Vars, z, ValAry) + type(SrvD_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call SrvD_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine SrvD_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(SrvD_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SrvD_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case (SrvD_z_BStC_DummyConstrState) + VarVals(1) = z%BStC(DL%i1)%DummyConstrState ! Scalar + case (SrvD_z_NStC_DummyConstrState) + VarVals(1) = z%NStC(DL%i1)%DummyConstrState ! Scalar + case (SrvD_z_TStC_DummyConstrState) + VarVals(1) = z%TStC(DL%i1)%DummyConstrState ! Scalar + case (SrvD_z_SStC_DummyConstrState) + VarVals(1) = z%SStC(DL%i1)%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SrvD_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SrvD_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call SrvD_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine SrvD_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SrvD_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SrvD_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + case (SrvD_z_BStC_DummyConstrState) + z%BStC(DL%i1)%DummyConstrState = VarVals(1) ! Scalar + case (SrvD_z_NStC_DummyConstrState) + z%NStC(DL%i1)%DummyConstrState = VarVals(1) ! Scalar + case (SrvD_z_TStC_DummyConstrState) + z%TStC(DL%i1)%DummyConstrState = VarVals(1) ! Scalar + case (SrvD_z_SStC_DummyConstrState) + z%SStC(DL%i1)%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function SrvD_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SrvD_z_DummyConstrState) + Name = "z%DummyConstrState" + case (SrvD_z_BStC_DummyConstrState) + Name = "z%BStC("//trim(Num2LStr(DL%i1))//")%DummyConstrState" + case (SrvD_z_NStC_DummyConstrState) + Name = "z%NStC("//trim(Num2LStr(DL%i1))//")%DummyConstrState" + case (SrvD_z_TStC_DummyConstrState) + Name = "z%TStC("//trim(Num2LStr(DL%i1))//")%DummyConstrState" + case (SrvD_z_SStC_DummyConstrState) + Name = "z%SStC("//trim(Num2LStr(DL%i1))//")%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine SrvD_VarsPackInput(Vars, u, ValAry) + type(SrvD_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call SrvD_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine SrvD_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(SrvD_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SrvD_u_BlPitch) + VarVals = u%BlPitch(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_Yaw) + VarVals(1) = u%Yaw ! Scalar + case (SrvD_u_YawRate) + VarVals(1) = u%YawRate ! Scalar + case (SrvD_u_LSS_Spd) + VarVals(1) = u%LSS_Spd ! Scalar + case (SrvD_u_HSS_Spd) + VarVals(1) = u%HSS_Spd ! Scalar + case (SrvD_u_RotSpeed) + VarVals(1) = u%RotSpeed ! Scalar + case (SrvD_u_ExternalYawPosCom) + VarVals(1) = u%ExternalYawPosCom ! Scalar + case (SrvD_u_ExternalYawRateCom) + VarVals(1) = u%ExternalYawRateCom ! Scalar + case (SrvD_u_ExternalBlPitchCom) + VarVals = u%ExternalBlPitchCom(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_ExternalGenTrq) + VarVals(1) = u%ExternalGenTrq ! Scalar + case (SrvD_u_ExternalElecPwr) + VarVals(1) = u%ExternalElecPwr ! Scalar + case (SrvD_u_ExternalHSSBrFrac) + VarVals(1) = u%ExternalHSSBrFrac ! Scalar + case (SrvD_u_ExternalBlAirfoilCom) + VarVals = u%ExternalBlAirfoilCom(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_ExternalCableDeltaL) + VarVals = u%ExternalCableDeltaL(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_ExternalCableDeltaLdot) + VarVals = u%ExternalCableDeltaLdot(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_TwrAccel) + VarVals(1) = u%TwrAccel ! Scalar + case (SrvD_u_YawErr) + VarVals(1) = u%YawErr ! Scalar + case (SrvD_u_WindDir) + VarVals(1) = u%WindDir ! Scalar + case (SrvD_u_RootMyc) + VarVals = u%RootMyc(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_YawBrTAxp) + VarVals(1) = u%YawBrTAxp ! Scalar + case (SrvD_u_YawBrTAyp) + VarVals(1) = u%YawBrTAyp ! Scalar + case (SrvD_u_LSSTipPxa) + VarVals(1) = u%LSSTipPxa ! Scalar + case (SrvD_u_RootMxc) + VarVals = u%RootMxc(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_LSSTipMxa) + VarVals(1) = u%LSSTipMxa ! Scalar + case (SrvD_u_LSSTipMya) + VarVals(1) = u%LSSTipMya ! Scalar + case (SrvD_u_LSSTipMza) + VarVals(1) = u%LSSTipMza ! Scalar + case (SrvD_u_LSSTipMys) + VarVals(1) = u%LSSTipMys ! Scalar + case (SrvD_u_LSSTipMzs) + VarVals(1) = u%LSSTipMzs ! Scalar + case (SrvD_u_YawBrMyn) + VarVals(1) = u%YawBrMyn ! Scalar + case (SrvD_u_YawBrMzn) + VarVals(1) = u%YawBrMzn ! Scalar + case (SrvD_u_NcIMURAxs) + VarVals(1) = u%NcIMURAxs ! Scalar + case (SrvD_u_NcIMURAys) + VarVals(1) = u%NcIMURAys ! Scalar + case (SrvD_u_NcIMURAzs) + VarVals(1) = u%NcIMURAzs ! Scalar + case (SrvD_u_RotPwr) + VarVals(1) = u%RotPwr ! Scalar + case (SrvD_u_HorWindV) + VarVals(1) = u%HorWindV ! Scalar + case (SrvD_u_YawAngle) + VarVals(1) = u%YawAngle ! Scalar + case (SrvD_u_LSShftFxa) + VarVals(1) = u%LSShftFxa ! Scalar + case (SrvD_u_LSShftFys) + VarVals(1) = u%LSShftFys ! Scalar + case (SrvD_u_LSShftFzs) + VarVals(1) = u%LSShftFzs ! Scalar + case (SrvD_u_fromSC) + VarVals = u%fromSC(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_fromSCglob) + VarVals = u%fromSCglob(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_PtfmMotionMesh) + call MV_PackMesh(V, u%PtfmMotionMesh, ValAry) ! Mesh + case (SrvD_u_BStCMotionMesh) + call MV_PackMesh(V, u%BStCMotionMesh(DL%i1, DL%i2), ValAry) ! Mesh + case (SrvD_u_NStCMotionMesh) + call MV_PackMesh(V, u%NStCMotionMesh(DL%i1), ValAry) ! Mesh + case (SrvD_u_TStCMotionMesh) + call MV_PackMesh(V, u%TStCMotionMesh(DL%i1), ValAry) ! Mesh + case (SrvD_u_SStCMotionMesh) + call MV_PackMesh(V, u%SStCMotionMesh(DL%i1), ValAry) ! Mesh + case (SrvD_u_LidSpeed) + VarVals = u%LidSpeed(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_MsrPositionsX) + VarVals = u%MsrPositionsX(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_MsrPositionsY) + VarVals = u%MsrPositionsY(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_u_MsrPositionsZ) + VarVals = u%MsrPositionsZ(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SrvD_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SrvD_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call SrvD_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine SrvD_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SrvD_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SrvD_u_BlPitch) + u%BlPitch(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_Yaw) + u%Yaw = VarVals(1) ! Scalar + case (SrvD_u_YawRate) + u%YawRate = VarVals(1) ! Scalar + case (SrvD_u_LSS_Spd) + u%LSS_Spd = VarVals(1) ! Scalar + case (SrvD_u_HSS_Spd) + u%HSS_Spd = VarVals(1) ! Scalar + case (SrvD_u_RotSpeed) + u%RotSpeed = VarVals(1) ! Scalar + case (SrvD_u_ExternalYawPosCom) + u%ExternalYawPosCom = VarVals(1) ! Scalar + case (SrvD_u_ExternalYawRateCom) + u%ExternalYawRateCom = VarVals(1) ! Scalar + case (SrvD_u_ExternalBlPitchCom) + u%ExternalBlPitchCom(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_ExternalGenTrq) + u%ExternalGenTrq = VarVals(1) ! Scalar + case (SrvD_u_ExternalElecPwr) + u%ExternalElecPwr = VarVals(1) ! Scalar + case (SrvD_u_ExternalHSSBrFrac) + u%ExternalHSSBrFrac = VarVals(1) ! Scalar + case (SrvD_u_ExternalBlAirfoilCom) + u%ExternalBlAirfoilCom(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_ExternalCableDeltaL) + u%ExternalCableDeltaL(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_ExternalCableDeltaLdot) + u%ExternalCableDeltaLdot(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_TwrAccel) + u%TwrAccel = VarVals(1) ! Scalar + case (SrvD_u_YawErr) + u%YawErr = VarVals(1) ! Scalar + case (SrvD_u_WindDir) + u%WindDir = VarVals(1) ! Scalar + case (SrvD_u_RootMyc) + u%RootMyc(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_YawBrTAxp) + u%YawBrTAxp = VarVals(1) ! Scalar + case (SrvD_u_YawBrTAyp) + u%YawBrTAyp = VarVals(1) ! Scalar + case (SrvD_u_LSSTipPxa) + u%LSSTipPxa = VarVals(1) ! Scalar + case (SrvD_u_RootMxc) + u%RootMxc(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_LSSTipMxa) + u%LSSTipMxa = VarVals(1) ! Scalar + case (SrvD_u_LSSTipMya) + u%LSSTipMya = VarVals(1) ! Scalar + case (SrvD_u_LSSTipMza) + u%LSSTipMza = VarVals(1) ! Scalar + case (SrvD_u_LSSTipMys) + u%LSSTipMys = VarVals(1) ! Scalar + case (SrvD_u_LSSTipMzs) + u%LSSTipMzs = VarVals(1) ! Scalar + case (SrvD_u_YawBrMyn) + u%YawBrMyn = VarVals(1) ! Scalar + case (SrvD_u_YawBrMzn) + u%YawBrMzn = VarVals(1) ! Scalar + case (SrvD_u_NcIMURAxs) + u%NcIMURAxs = VarVals(1) ! Scalar + case (SrvD_u_NcIMURAys) + u%NcIMURAys = VarVals(1) ! Scalar + case (SrvD_u_NcIMURAzs) + u%NcIMURAzs = VarVals(1) ! Scalar + case (SrvD_u_RotPwr) + u%RotPwr = VarVals(1) ! Scalar + case (SrvD_u_HorWindV) + u%HorWindV = VarVals(1) ! Scalar + case (SrvD_u_YawAngle) + u%YawAngle = VarVals(1) ! Scalar + case (SrvD_u_LSShftFxa) + u%LSShftFxa = VarVals(1) ! Scalar + case (SrvD_u_LSShftFys) + u%LSShftFys = VarVals(1) ! Scalar + case (SrvD_u_LSShftFzs) + u%LSShftFzs = VarVals(1) ! Scalar + case (SrvD_u_fromSC) + u%fromSC(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_fromSCglob) + u%fromSCglob(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_PtfmMotionMesh) + call MV_UnpackMesh(V, ValAry, u%PtfmMotionMesh) ! Mesh + case (SrvD_u_BStCMotionMesh) + call MV_UnpackMesh(V, ValAry, u%BStCMotionMesh(DL%i1, DL%i2)) ! Mesh + case (SrvD_u_NStCMotionMesh) + call MV_UnpackMesh(V, ValAry, u%NStCMotionMesh(DL%i1)) ! Mesh + case (SrvD_u_TStCMotionMesh) + call MV_UnpackMesh(V, ValAry, u%TStCMotionMesh(DL%i1)) ! Mesh + case (SrvD_u_SStCMotionMesh) + call MV_UnpackMesh(V, ValAry, u%SStCMotionMesh(DL%i1)) ! Mesh + case (SrvD_u_LidSpeed) + u%LidSpeed(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_MsrPositionsX) + u%MsrPositionsX(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_MsrPositionsY) + u%MsrPositionsY(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_u_MsrPositionsZ) + u%MsrPositionsZ(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function SrvD_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SrvD_u_BlPitch) + Name = "u%BlPitch" + case (SrvD_u_Yaw) + Name = "u%Yaw" + case (SrvD_u_YawRate) + Name = "u%YawRate" + case (SrvD_u_LSS_Spd) + Name = "u%LSS_Spd" + case (SrvD_u_HSS_Spd) + Name = "u%HSS_Spd" + case (SrvD_u_RotSpeed) + Name = "u%RotSpeed" + case (SrvD_u_ExternalYawPosCom) + Name = "u%ExternalYawPosCom" + case (SrvD_u_ExternalYawRateCom) + Name = "u%ExternalYawRateCom" + case (SrvD_u_ExternalBlPitchCom) + Name = "u%ExternalBlPitchCom" + case (SrvD_u_ExternalGenTrq) + Name = "u%ExternalGenTrq" + case (SrvD_u_ExternalElecPwr) + Name = "u%ExternalElecPwr" + case (SrvD_u_ExternalHSSBrFrac) + Name = "u%ExternalHSSBrFrac" + case (SrvD_u_ExternalBlAirfoilCom) + Name = "u%ExternalBlAirfoilCom" + case (SrvD_u_ExternalCableDeltaL) + Name = "u%ExternalCableDeltaL" + case (SrvD_u_ExternalCableDeltaLdot) + Name = "u%ExternalCableDeltaLdot" + case (SrvD_u_TwrAccel) + Name = "u%TwrAccel" + case (SrvD_u_YawErr) + Name = "u%YawErr" + case (SrvD_u_WindDir) + Name = "u%WindDir" + case (SrvD_u_RootMyc) + Name = "u%RootMyc" + case (SrvD_u_YawBrTAxp) + Name = "u%YawBrTAxp" + case (SrvD_u_YawBrTAyp) + Name = "u%YawBrTAyp" + case (SrvD_u_LSSTipPxa) + Name = "u%LSSTipPxa" + case (SrvD_u_RootMxc) + Name = "u%RootMxc" + case (SrvD_u_LSSTipMxa) + Name = "u%LSSTipMxa" + case (SrvD_u_LSSTipMya) + Name = "u%LSSTipMya" + case (SrvD_u_LSSTipMza) + Name = "u%LSSTipMza" + case (SrvD_u_LSSTipMys) + Name = "u%LSSTipMys" + case (SrvD_u_LSSTipMzs) + Name = "u%LSSTipMzs" + case (SrvD_u_YawBrMyn) + Name = "u%YawBrMyn" + case (SrvD_u_YawBrMzn) + Name = "u%YawBrMzn" + case (SrvD_u_NcIMURAxs) + Name = "u%NcIMURAxs" + case (SrvD_u_NcIMURAys) + Name = "u%NcIMURAys" + case (SrvD_u_NcIMURAzs) + Name = "u%NcIMURAzs" + case (SrvD_u_RotPwr) + Name = "u%RotPwr" + case (SrvD_u_HorWindV) + Name = "u%HorWindV" + case (SrvD_u_YawAngle) + Name = "u%YawAngle" + case (SrvD_u_LSShftFxa) + Name = "u%LSShftFxa" + case (SrvD_u_LSShftFys) + Name = "u%LSShftFys" + case (SrvD_u_LSShftFzs) + Name = "u%LSShftFzs" + case (SrvD_u_fromSC) + Name = "u%fromSC" + case (SrvD_u_fromSCglob) + Name = "u%fromSCglob" + case (SrvD_u_PtfmMotionMesh) + Name = "u%PtfmMotionMesh" + case (SrvD_u_BStCMotionMesh) + Name = "u%BStCMotionMesh("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")" + case (SrvD_u_NStCMotionMesh) + Name = "u%NStCMotionMesh("//trim(Num2LStr(DL%i1))//")" + case (SrvD_u_TStCMotionMesh) + Name = "u%TStCMotionMesh("//trim(Num2LStr(DL%i1))//")" + case (SrvD_u_SStCMotionMesh) + Name = "u%SStCMotionMesh("//trim(Num2LStr(DL%i1))//")" + case (SrvD_u_LidSpeed) + Name = "u%LidSpeed" + case (SrvD_u_MsrPositionsX) + Name = "u%MsrPositionsX" + case (SrvD_u_MsrPositionsY) + Name = "u%MsrPositionsY" + case (SrvD_u_MsrPositionsZ) + Name = "u%MsrPositionsZ" + case default + Name = "Unknown Field" + end select +end function + +subroutine SrvD_VarsPackOutput(Vars, y, ValAry) + type(SrvD_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call SrvD_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine SrvD_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(SrvD_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SrvD_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_y_BlPitchCom) + VarVals = y%BlPitchCom(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_y_BlAirfoilCom) + VarVals = y%BlAirfoilCom(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_y_YawMom) + VarVals(1) = y%YawMom ! Scalar + case (SrvD_y_YawPosCom) + VarVals(1) = y%YawPosCom ! Scalar + case (SrvD_y_YawRateCom) + VarVals(1) = y%YawRateCom ! Scalar + case (SrvD_y_GenTrq) + VarVals(1) = y%GenTrq ! Scalar + case (SrvD_y_HSSBrTrqC) + VarVals(1) = y%HSSBrTrqC ! Scalar + case (SrvD_y_ElecPwr) + VarVals(1) = y%ElecPwr ! Scalar + case (SrvD_y_TBDrCon) + VarVals = y%TBDrCon(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_y_CableDeltaL) + VarVals = y%CableDeltaL(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_y_CableDeltaLdot) + VarVals = y%CableDeltaLdot(V%iLB:V%iUB) ! Rank 1 Array + case (SrvD_y_BStCLoadMesh) + call MV_PackMesh(V, y%BStCLoadMesh(DL%i1, DL%i2), ValAry) ! Mesh + case (SrvD_y_NStCLoadMesh) + call MV_PackMesh(V, y%NStCLoadMesh(DL%i1), ValAry) ! Mesh + case (SrvD_y_TStCLoadMesh) + call MV_PackMesh(V, y%TStCLoadMesh(DL%i1), ValAry) ! Mesh + case (SrvD_y_SStCLoadMesh) + call MV_PackMesh(V, y%SStCLoadMesh(DL%i1), ValAry) ! Mesh + case (SrvD_y_toSC) + VarVals = y%toSC(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SrvD_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SrvD_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call SrvD_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine SrvD_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SrvD_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SrvD_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_y_BlPitchCom) + y%BlPitchCom(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_y_BlAirfoilCom) + y%BlAirfoilCom(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_y_YawMom) + y%YawMom = VarVals(1) ! Scalar + case (SrvD_y_YawPosCom) + y%YawPosCom = VarVals(1) ! Scalar + case (SrvD_y_YawRateCom) + y%YawRateCom = VarVals(1) ! Scalar + case (SrvD_y_GenTrq) + y%GenTrq = VarVals(1) ! Scalar + case (SrvD_y_HSSBrTrqC) + y%HSSBrTrqC = VarVals(1) ! Scalar + case (SrvD_y_ElecPwr) + y%ElecPwr = VarVals(1) ! Scalar + case (SrvD_y_TBDrCon) + y%TBDrCon(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_y_CableDeltaL) + y%CableDeltaL(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_y_CableDeltaLdot) + y%CableDeltaLdot(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SrvD_y_BStCLoadMesh) + call MV_UnpackMesh(V, ValAry, y%BStCLoadMesh(DL%i1, DL%i2)) ! Mesh + case (SrvD_y_NStCLoadMesh) + call MV_UnpackMesh(V, ValAry, y%NStCLoadMesh(DL%i1)) ! Mesh + case (SrvD_y_TStCLoadMesh) + call MV_UnpackMesh(V, ValAry, y%TStCLoadMesh(DL%i1)) ! Mesh + case (SrvD_y_SStCLoadMesh) + call MV_UnpackMesh(V, ValAry, y%SStCLoadMesh(DL%i1)) ! Mesh + case (SrvD_y_toSC) + y%toSC(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function SrvD_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SrvD_y_WriteOutput) + Name = "y%WriteOutput" + case (SrvD_y_BlPitchCom) + Name = "y%BlPitchCom" + case (SrvD_y_BlAirfoilCom) + Name = "y%BlAirfoilCom" + case (SrvD_y_YawMom) + Name = "y%YawMom" + case (SrvD_y_YawPosCom) + Name = "y%YawPosCom" + case (SrvD_y_YawRateCom) + Name = "y%YawRateCom" + case (SrvD_y_GenTrq) + Name = "y%GenTrq" + case (SrvD_y_HSSBrTrqC) + Name = "y%HSSBrTrqC" + case (SrvD_y_ElecPwr) + Name = "y%ElecPwr" + case (SrvD_y_TBDrCon) + Name = "y%TBDrCon" + case (SrvD_y_CableDeltaL) + Name = "y%CableDeltaL" + case (SrvD_y_CableDeltaLdot) + Name = "y%CableDeltaLdot" + case (SrvD_y_BStCLoadMesh) + Name = "y%BStCLoadMesh("//trim(Num2LStr(DL%i1))//", "//trim(Num2LStr(DL%i2))//")" + case (SrvD_y_NStCLoadMesh) + Name = "y%NStCLoadMesh("//trim(Num2LStr(DL%i1))//")" + case (SrvD_y_TStCLoadMesh) + Name = "y%TStCLoadMesh("//trim(Num2LStr(DL%i1))//")" + case (SrvD_y_SStCLoadMesh) + Name = "y%SStCLoadMesh("//trim(Num2LStr(DL%i1))//")" + case (SrvD_y_toSC) + Name = "y%toSC" + case default + Name = "Unknown Field" + end select +end function + END MODULE ServoDyn_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index 105e73d1ac..c184ed194c 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -248,7 +248,18 @@ MODULE StrucCtrl_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MeasVel !< StC measured relative velocity of tmd mass (local coordinates) signal to controller [m/s] END TYPE StC_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: StC_x_StC_x = 1 ! StC%StC_x + integer(IntKi), public, parameter :: StC_z_DummyConstrState = 2 ! StC%DummyConstrState + integer(IntKi), public, parameter :: StC_u_Mesh = 3 ! StC%Mesh(DL%i1) + integer(IntKi), public, parameter :: StC_u_CmdStiff = 4 ! StC%CmdStiff + integer(IntKi), public, parameter :: StC_u_CmdDamp = 5 ! StC%CmdDamp + integer(IntKi), public, parameter :: StC_u_CmdBrake = 6 ! StC%CmdBrake + integer(IntKi), public, parameter :: StC_u_CmdForce = 7 ! StC%CmdForce + integer(IntKi), public, parameter :: StC_y_Mesh = 8 ! StC%Mesh(DL%i1) + integer(IntKi), public, parameter :: StC_y_MeasDisp = 9 ! StC%MeasDisp + integer(IntKi), public, parameter :: StC_y_MeasVel = 10 ! StC%MeasVel + +contains subroutine StC_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) type(StC_InputFile), intent(in) :: SrcInputFileData @@ -2300,5 +2311,317 @@ SUBROUTINE StC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er y_out%MeasVel = a1*y1%MeasVel + a2*y2%MeasVel + a3*y3%MeasVel END IF ! check if allocated END SUBROUTINE + +function StC_InputMeshPointer(u, DL) result(Mesh) + type(StC_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (StC_u_Mesh) + Mesh => u%Mesh(DL%i1) + end select +end function + +function StC_OutputMeshPointer(y, DL) result(Mesh) + type(StC_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (StC_y_Mesh) + Mesh => y%Mesh(DL%i1) + end select +end function + +subroutine StC_VarsPackContState(Vars, x, ValAry) + type(StC_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call StC_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine StC_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(StC_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (StC_x_StC_x) + VarVals = x%StC_x(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine StC_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(StC_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call StC_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine StC_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(StC_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (StC_x_StC_x) + x%StC_x(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + +function StC_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (StC_x_StC_x) + Name = "x%StC_x" + case default + Name = "Unknown Field" + end select +end function + +subroutine StC_VarsPackContStateDeriv(Vars, x, ValAry) + type(StC_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call StC_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine StC_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(StC_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (StC_x_StC_x) + VarVals = x%StC_x(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine StC_VarsPackConstrState(Vars, z, ValAry) + type(StC_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call StC_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine StC_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(StC_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (StC_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine StC_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(StC_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call StC_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine StC_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(StC_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (StC_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function StC_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (StC_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine StC_VarsPackInput(Vars, u, ValAry) + type(StC_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call StC_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine StC_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(StC_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (StC_u_Mesh) + call MV_PackMesh(V, u%Mesh(DL%i1), ValAry) ! Mesh + case (StC_u_CmdStiff) + VarVals = u%CmdStiff(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (StC_u_CmdDamp) + VarVals = u%CmdDamp(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (StC_u_CmdBrake) + VarVals = u%CmdBrake(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (StC_u_CmdForce) + VarVals = u%CmdForce(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine StC_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(StC_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call StC_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine StC_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(StC_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (StC_u_Mesh) + call MV_UnpackMesh(V, ValAry, u%Mesh(DL%i1)) ! Mesh + case (StC_u_CmdStiff) + u%CmdStiff(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (StC_u_CmdDamp) + u%CmdDamp(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (StC_u_CmdBrake) + u%CmdBrake(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (StC_u_CmdForce) + u%CmdForce(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + +function StC_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (StC_u_Mesh) + Name = "u%Mesh("//trim(Num2LStr(DL%i1))//")" + case (StC_u_CmdStiff) + Name = "u%CmdStiff" + case (StC_u_CmdDamp) + Name = "u%CmdDamp" + case (StC_u_CmdBrake) + Name = "u%CmdBrake" + case (StC_u_CmdForce) + Name = "u%CmdForce" + case default + Name = "Unknown Field" + end select +end function + +subroutine StC_VarsPackOutput(Vars, y, ValAry) + type(StC_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call StC_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine StC_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(StC_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (StC_y_Mesh) + call MV_PackMesh(V, y%Mesh(DL%i1), ValAry) ! Mesh + case (StC_y_MeasDisp) + VarVals = y%MeasDisp(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (StC_y_MeasVel) + VarVals = y%MeasVel(V%iLB:V%iUB,V%j) ! Rank 2 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine StC_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(StC_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call StC_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine StC_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(StC_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (StC_y_Mesh) + call MV_UnpackMesh(V, ValAry, y%Mesh(DL%i1)) ! Mesh + case (StC_y_MeasDisp) + y%MeasDisp(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (StC_y_MeasVel) + y%MeasVel(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + end select + end associate +end subroutine + +function StC_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (StC_y_Mesh) + Name = "y%Mesh("//trim(Num2LStr(DL%i1))//")" + case (StC_y_MeasDisp) + Name = "y%MeasDisp" + case (StC_y_MeasVel) + Name = "y%MeasVel" + case default + Name = "Unknown Field" + end select +end function + END MODULE StrucCtrl_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/simple-elastodyn/src/SED.f90 b/modules/simple-elastodyn/src/SED.f90 index e1b433356a..a628f3b4f0 100644 --- a/modules/simple-elastodyn/src/SED.f90 +++ b/modules/simple-elastodyn/src/SED.f90 @@ -37,15 +37,14 @@ MODULE SED public :: SED_UpdateStates public :: SED_CalcOutput public :: SED_CalcContStateDeriv - + public :: SED_JacobianPInput + public :: SED_JacobianPContState + ! Linearization is not supported by this module, so the following routines are omitted !public :: SED_CalcConstrStateResidual !public :: SED_UpdateDiscState - !public :: SED_JacobianPInput - !public :: SED_JacobianPContState !public :: SED_JacobianPDiscState !public :: SED_JacobianPConstrState - !public :: SED_GetOP CONTAINS @@ -141,6 +140,10 @@ SUBROUTINE SED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOu ! Set InitOutputs call Init_InitY(ErrStat2,ErrMsg2); if (Failed()) return + ! Initialize module variables + call SED_InitVars(u, p, x, y, m, InitOut%Vars, InputFileData, .false., ErrStat2, ErrMsg2) + if (Failed()) return + contains logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -532,6 +535,146 @@ end subroutine Init_Y END SUBROUTINE SED_Init +subroutine SED_InitVars(u, p, x, y, m, Vars, InputFileData, Linearize, ErrStat, ErrMsg) + type(SED_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(SED_ParameterType), intent(inout) :: p !< Parameters + type(SED_ContinuousStateType), intent(inout) :: x !< Continuous state + type(SED_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(SED_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(ModVarsType), intent(inout) :: Vars !< Module variables + type(SED_InputFile), intent(in) :: InputFileData !< Input file data + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_No ne + + character(*), parameter :: RoutineName = 'SED_InitVars' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + real(R8Ki) :: MaxThrust, MaxTorque, ScaleLength + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = "" + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + call MV_AddVar(Vars%x, 'GeneratorAzimuth', FieldAngularDisp, & + DL=DatLoc(SED_x_QT), iAry=DOF_Az, & + Flags=VF_DerivOrder2, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Variable speed generator DOF (internal DOF index = DOF_Az), rad'], & + Active=p%GenDOF) + + call MV_AddVar(Vars%x, 'GeneratorAzimuth', FieldAngularVel, & + DL=DatLoc(SED_x_QDT), iAry=DOF_Az, & + Flags=VF_DerivOrder2, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['First time derivative of Variable speed generator DOF (internal DOF index = DOF_Az), rad/s'], & + Active=p%GenDOF) + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + ScaleLength = max(p%TipRad, p%TowerHt, 1.0_ReKi) + MaxThrust = 490.0_R8Ki * pi_D / 9.0_R8Ki * ScaleLength**2 + MaxTorque = 122.5_R8Ki * pi_D / 27.0_R8Ki * ScaleLength**3 + + call MV_AddMeshVar(Vars%u, "Hub", LoadFields, & + DL=DatLoc(SED_u_HubPtLoad), & + Mesh=u%HubPtLoad, & + Perturbs=[MaxThrust / 100.0_R8Ki, & + MaxTorque / 100.0_R8Ki]) + + call MV_AddVar(Vars%u, "GenTrq", FieldScalar, & + DL=DatLoc(SED_u_GenTrq), & + Flags=VF_Linearize, & + Perturb=MaxTorque / (100.0_R8Ki*p%GBoxRatio), & + LinNames=['Generator torque, Nm']) + + call MV_AddVar(Vars%u, "BlPitchCom", FieldScalar, & + DL=DatLoc(SED_u_BlPitchCom), iAry=1, & + Num=p%NumBl, & + Flags=VF_RotFrame + VF_Linearize + VF_2PI, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=[('Blade '//trim(num2lstr(i))//' pitch command, rad', i=1,p%NumBl)]) + + call MV_AddVar(Vars%u, "YawPosCom", FieldScalar, & + DL=DatLoc(SED_u_YawPosCom), & + Flags=VF_Linearize, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Yaw position command, rad']) + + call MV_AddVar(Vars%u, "YawRateCom", FieldScalar, & + DL=DatLoc(SED_u_YawRateCom), & + Flags=VF_Linearize, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Yaw rate command, rad/s']) + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + call MV_AddMeshVar(Vars%y, 'Hub', MotionFields, & + DatLoc(SED_y_HubPtMotion), & + Mesh=y%HubPtMotion) + + call MV_AddMeshVar(Vars%y, 'Platform', MotionFields, & + DatLoc(SED_y_PlatformPtMesh), & + Mesh=y%PlatformPtMesh, & + Flags=VF_SmallAngle) + + call MV_AddMeshVar(Vars%y, 'Tower', MotionFields, & + DatLoc(SED_y_TowerLn2Mesh), & + Mesh=y%TowerLn2Mesh, & + Flags=ior(VF_Line, VF_SmallAngle)) + + do i = 1, p%NumBl + call MV_AddMeshVar(Vars%y, 'Blade root '//Num2LStr(i), MotionFields, & + DatLoc(SED_y_BladeRootMotion, i), & + Mesh=y%BladeRootMotion(i)) + end do + + call MV_AddMeshVar(Vars%y, 'Nacelle', MotionFields, & + DatLoc(SED_y_NacelleMotion), & + Mesh=y%NacelleMotion) + + !-------------------- + ! Non-mesh outputs + !-------------------- + + call MV_AddVar(Vars%y, 'Yaw', FieldScalar, & + DatLoc(SED_y_Yaw), & + Flags=VF_2PI, & + LinNames=['Yaw, rad']) + + call MV_AddVar(Vars%y, 'YawRate', FieldScalar, & + DatLoc(SED_y_YawRate), & + LinNames=['YawRate, rad/s']) + + call MV_AddVar(Vars%y, 'HSS_Spd', FieldScalar, & + DatLoc(SED_y_HSS_Spd), & + LinNames=['HSS_Spd, rad/s']) + + !---------------------------------------------------------------------------- + ! Initialization dependent on linearization + !---------------------------------------------------------------------------- + + call MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + call SED_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SED_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SED_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SED_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the end of the simulation. @@ -1375,6 +1518,250 @@ logical function Failed() end function Failed END SUBROUTINE SED_CalcContStateDeriv +!> 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 SED_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +!.................................................................................................................................. + + type(ModVarsType), INTENT(IN ) :: Vars !< Module variables + REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point + TYPE(SED_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(SED_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(SED_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(SED_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(SED_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(SED_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(SED_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(SED_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] + + CHARACTER(*), PARAMETER :: RoutineName = 'SED_JacobianPInput' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, iCol + + ErrStat = ErrID_None + ErrMsg = '' + + ! Update copy of the inputs to perturb + call SED_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SED_VarsPackInput(Vars, u, m%Jac%u) + + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + if (present(dYdu)) then + + ! Allocate dYdu if not allocated + if (.not. allocated(dYdu)) then + call AllocAry(dYdu, m%Jac%Ny, m%Jac%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return + end if + + ! Loop through input variables + do i = 1, size(Vars%u) + + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%u(i)%Num + + ! Calculate column index + iCol = Vars%u(i)%iLoc(1) + j - 1 + + ! Calculate positive perturbation + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call SED_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call SED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call SED_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call SED_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call SED_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call SED_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) + + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(Vars%y, Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,iCol)) + end do + end do + end if + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + if (present(dXdu) .and. (m%Jac%Nx > 0)) then + + ! Allocate dXdu if not allocated + if (.not. allocated(dXdu)) then + call AllocAry(dXdu, m%Jac%Nx, m%Jac%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return + end if + + ! Loop through input variables + do i = 1, size(Vars%u) + + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%u(i)%Num + + ! Calculate column index + iCol = Vars%u(i)%iLoc(1) + j - 1 + + ! Calculate positive perturbation + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call SED_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call SED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call SED_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call SED_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call SED_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call SED_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_neg) + + ! Get partial derivative via central difference and store in full linearization array + dXdu(:,iCol) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%u(i)%Perturb) + end do + end do + end if + + if (present(dXddu)) then + if (allocated(dXddu)) deallocate(dXddu) + end if + + if (present(dZdu)) then + if (allocated(dZdu)) deallocate(dZdu) + end if + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +END SUBROUTINE SED_JacobianPInput + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions +!! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. +SUBROUTINE SED_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) + + type(ModVarsType), INTENT(IN ) :: Vars !< Module variables + REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point + TYPE(SED_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(SED_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(SED_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(SED_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(SED_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(SED_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(SED_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(SED_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions (Y) with respect to the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) with respect to the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) with respect to the continuous states (x) [intent in to avoid deallocation] + + CHARACTER(*), PARAMETER :: RoutineName = 'ED_JacobianPContState' + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + INTEGER(IntKi) :: i, j, iCol + + ErrStat = ErrID_None + ErrMsg = '' + + ! Copy state values + call SED_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SED_VarsPackContState(Vars, x, m%Jac%x) + + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + if (present(dYdx)) then + + ! Allocate dYdx if not allocated + if (.not. allocated(dYdx)) then + call AllocAry(dYdx, m%Jac%Ny, m%Jac%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return + end if + + ! Loop through state variables + do i = 1, size(Vars%x) + + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%x(i)%Num + + ! Calculate column index + iCol = Vars%x(i)%iLoc(1) + j - 1 + + ! Calculate positive perturbation + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call SED_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call SED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call SED_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call SED_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call SED_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call SED_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) + + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(Vars%y, Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,iCol)) + end do + end do + + end if + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + if (present(dXdx) .and. (m%Jac%Nx > 0)) then + + ! Allocate dXdx if not allocated + if (.not. allocated(dXdx)) then + call AllocAry(dXdx, m%Jac%Nx, m%Jac%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return + end if + + ! Loop through state variables + do i = 1, size(Vars%x) + + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%x(i)%Num + + ! Calculate column index + iCol = Vars%x(i)%iLoc(1) + j - 1 + + ! Calculate positive perturbation + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call SED_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call SED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call SED_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call SED_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call SED_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call SED_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_neg) + + ! Get partial derivative via central difference and store in full linearization array + dXdx(:,iCol) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%x(i)%Perturb) + end do + end do + end if + + if (present(dXddx)) then + if (allocated(dXddx)) deallocate(dXddx) + end if + + if (present(dZdx)) then + if (allocated(dZdx)) deallocate(dZdx) + end if + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +END SUBROUTINE SED_JacobianPContState END MODULE SED !********************************************************************************************************************************** diff --git a/modules/simple-elastodyn/src/SED_Registry.txt b/modules/simple-elastodyn/src/SED_Registry.txt index 5f52f1ea70..da9b22187c 100644 --- a/modules/simple-elastodyn/src/SED_Registry.txt +++ b/modules/simple-elastodyn/src/SED_Registry.txt @@ -64,7 +64,7 @@ typedef ^ InitOutputType ReKi PlatformPos {6} - 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 GenDOF - - - "whether the generator DOF is on (true) or off (false)" - - +typedef ^ InitOutputType ModVarsType Vars - - - "Module variables" - # ..... Inputs .................................................................................................................... # inputs on meshes: @@ -154,4 +154,9 @@ typedef ^ MiscVarType MeshMapType mapNac2Hub - - typedef ^ MiscVarType MeshMapType mapHub2Root {:} - - "Mesh mapping from Hub to BladeRootMotion (blade pitch overwritten in calc)" - typedef ^ MiscVarType R8Ki QD2T {:} - - "Current estimate of first derivative of QD (acceleration matrix) for each degree of freedom" typedef ^ MiscVarType ReKi HubPt_X {3} - - "X orientation of hub calculated in CalcOutput -- saving so we don't recalculate a bunch of things to get it in UpdateStates" +typedef ^ MiscVarType ModJacType Jac - - - "Values corresponding to module variables" +typedef ^ MiscVarType SED_ContinuousStateType x_perturb - - - "Continuous state type for linearization perturbation" - +typedef ^ MiscVarType SED_ContinuousStateType dxdt_lin - - - "Continuous state type for linearization output" - +typedef ^ MiscVarType SED_InputType u_perturb - - - "Input type for linearization perturbation" - +typedef ^ MiscVarType SED_OutputType y_lin - - - "Output type for linearization output" - diff --git a/modules/simple-elastodyn/src/SED_Types.f90 b/modules/simple-elastodyn/src/SED_Types.f90 index e5b3e3ddf1..5b72b2b336 100644 --- a/modules/simple-elastodyn/src/SED_Types.f90 +++ b/modules/simple-elastodyn/src/SED_Types.f90 @@ -33,7 +33,7 @@ MODULE SED_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: SED_NMX = 4 ! Used in updating predictor-corrector values (size of state history) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SED_NMX = 4 ! Used in updating predictor-corrector values (size of state history) [-] ! ========= SED_InputFile ======= TYPE, PUBLIC :: SED_InputFile LOGICAL :: Echo = .false. !< Echo the input file [-] @@ -85,6 +85,7 @@ MODULE SED_Types REAL(ReKi) :: HubRad = 0.0_ReKi !< Preconed hub radius (distance from the rotor apex to the blade root) [m] REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Initial or fixed rotor speed [rad/s] LOGICAL :: GenDOF = .false. !< whether the generator DOF is on (true) or off (false) [-] + TYPE(ModVarsType) :: Vars !< Module variables [-] END TYPE SED_InitOutputType ! ======================= ! ========= SED_InputType ======= @@ -178,9 +179,38 @@ MODULE SED_Types TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: mapHub2Root !< Mesh mapping from Hub to BladeRootMotion (blade pitch overwritten in calc) [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: QD2T !< Current estimate of first derivative of QD (acceleration matrix) for each degree of freedom [-] REAL(ReKi) , DIMENSION(1:3) :: HubPt_X = 0.0_ReKi !< X orientation of hub calculated in CalcOutput -- saving so we don't recalculate a bunch of things to get it in UpdateStates [-] + TYPE(ModJacType) :: Jac !< Values corresponding to module variables [-] + TYPE(SED_ContinuousStateType) :: x_perturb !< Continuous state type for linearization perturbation [-] + TYPE(SED_ContinuousStateType) :: dxdt_lin !< Continuous state type for linearization output [-] + TYPE(SED_InputType) :: u_perturb !< Input type for linearization perturbation [-] + TYPE(SED_OutputType) :: y_lin !< Output type for linearization output [-] END TYPE SED_MiscVarType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: SED_x_QT = 1 ! SED%QT + integer(IntKi), public, parameter :: SED_x_QDT = 2 ! SED%QDT + integer(IntKi), public, parameter :: SED_z_DummyConstrState = 3 ! SED%DummyConstrState + integer(IntKi), public, parameter :: SED_u_HubPtLoad = 4 ! SED%HubPtLoad + integer(IntKi), public, parameter :: SED_u_HSSBrTrqC = 5 ! SED%HSSBrTrqC + integer(IntKi), public, parameter :: SED_u_GenTrq = 6 ! SED%GenTrq + integer(IntKi), public, parameter :: SED_u_BlPitchCom = 7 ! SED%BlPitchCom + integer(IntKi), public, parameter :: SED_u_YawPosCom = 8 ! SED%YawPosCom + integer(IntKi), public, parameter :: SED_u_YawRateCom = 9 ! SED%YawRateCom + integer(IntKi), public, parameter :: SED_y_BladeRootMotion = 10 ! SED%BladeRootMotion(DL%i1) + integer(IntKi), public, parameter :: SED_y_HubPtMotion = 11 ! SED%HubPtMotion + integer(IntKi), public, parameter :: SED_y_NacelleMotion = 12 ! SED%NacelleMotion + integer(IntKi), public, parameter :: SED_y_TowerLn2Mesh = 13 ! SED%TowerLn2Mesh + integer(IntKi), public, parameter :: SED_y_PlatformPtMesh = 14 ! SED%PlatformPtMesh + integer(IntKi), public, parameter :: SED_y_LSSTipPxa = 15 ! SED%LSSTipPxa + integer(IntKi), public, parameter :: SED_y_RotSpeed = 16 ! SED%RotSpeed + integer(IntKi), public, parameter :: SED_y_RotPwr = 17 ! SED%RotPwr + integer(IntKi), public, parameter :: SED_y_RotTrq = 18 ! SED%RotTrq + integer(IntKi), public, parameter :: SED_y_HSS_Spd = 19 ! SED%HSS_Spd + integer(IntKi), public, parameter :: SED_y_Yaw = 20 ! SED%Yaw + integer(IntKi), public, parameter :: SED_y_YawRate = 21 ! SED%YawRate + integer(IntKi), public, parameter :: SED_y_BlPitch = 22 ! SED%BlPitch + integer(IntKi), public, parameter :: SED_y_WriteOutput = 23 ! SED%WriteOutput + +contains subroutine SED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) type(SED_InputFile), intent(in) :: SrcInputFileData @@ -425,6 +455,9 @@ subroutine SED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er DstInitOutputData%HubRad = SrcInitOutputData%HubRad DstInitOutputData%RotSpeed = SrcInitOutputData%RotSpeed DstInitOutputData%GenDOF = SrcInitOutputData%GenDOF + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine SED_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -447,6 +480,8 @@ subroutine SED_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%BlPitch)) then deallocate(InitOutputData%BlPitch) end if + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine SED_PackInitOutput(RF, Indata) @@ -466,6 +501,7 @@ subroutine SED_PackInitOutput(RF, Indata) call RegPack(RF, InData%HubRad) call RegPack(RF, InData%RotSpeed) call RegPack(RF, InData%GenDOF) + call NWTC_Library_PackModVarsType(RF, InData%Vars) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -489,6 +525,7 @@ subroutine SED_UnPackInitOutput(RF, OutData) call RegUnpack(RF, OutData%HubRad); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%GenDOF); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end subroutine subroutine SED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -1212,6 +1249,21 @@ subroutine SED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%QD2T = SrcMiscData%QD2T end if DstMiscData%HubPt_X = SrcMiscData%HubPt_X + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SED_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SED_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SED_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SED_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine SED_DestroyMisc(MiscData, ErrStat, ErrMsg) @@ -1242,6 +1294,16 @@ subroutine SED_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%QD2T)) then deallocate(MiscData%QD2T) end if + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SED_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SED_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SED_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SED_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine SED_PackMisc(RF, Indata) @@ -1264,6 +1326,11 @@ subroutine SED_PackMisc(RF, Indata) end if call RegPackAlloc(RF, InData%QD2T) call RegPack(RF, InData%HubPt_X) + call NWTC_Library_PackModJacType(RF, InData%Jac) + call SED_PackContState(RF, InData%x_perturb) + call SED_PackContState(RF, InData%dxdt_lin) + call SED_PackInput(RF, InData%u_perturb) + call SED_PackOutput(RF, InData%y_lin) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1293,6 +1360,11 @@ subroutine SED_UnPackMisc(RF, OutData) end if call RegUnpackAlloc(RF, OutData%QD2T); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%HubPt_X); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call SED_UnpackContState(RF, OutData%x_perturb) ! x_perturb + call SED_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin + call SED_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call SED_UnpackOutput(RF, OutData%y_lin) ! y_lin end subroutine subroutine SED_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) @@ -1686,5 +1758,405 @@ SUBROUTINE SED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function SED_InputMeshPointer(u, DL) result(Mesh) + type(SED_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (SED_u_HubPtLoad) + Mesh => u%HubPtLoad + end select +end function + +function SED_OutputMeshPointer(y, DL) result(Mesh) + type(SED_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (SED_y_BladeRootMotion) + Mesh => y%BladeRootMotion(DL%i1) + case (SED_y_HubPtMotion) + Mesh => y%HubPtMotion + case (SED_y_NacelleMotion) + Mesh => y%NacelleMotion + case (SED_y_TowerLn2Mesh) + Mesh => y%TowerLn2Mesh + case (SED_y_PlatformPtMesh) + Mesh => y%PlatformPtMesh + end select +end function + +subroutine SED_VarsPackContState(Vars, x, ValAry) + type(SED_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SED_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine SED_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SED_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SED_x_QT) + VarVals = x%QT(V%iLB:V%iUB) ! Rank 1 Array + case (SED_x_QDT) + VarVals = x%QDT(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SED_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SED_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SED_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine SED_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SED_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SED_x_QT) + x%QT(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SED_x_QDT) + x%QDT(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function SED_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SED_x_QT) + Name = "x%QT" + case (SED_x_QDT) + Name = "x%QDT" + case default + Name = "Unknown Field" + end select +end function + +subroutine SED_VarsPackContStateDeriv(Vars, x, ValAry) + type(SED_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SED_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine SED_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SED_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SED_x_QT) + VarVals = x%QT(V%iLB:V%iUB) ! Rank 1 Array + case (SED_x_QDT) + VarVals = x%QDT(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SED_VarsPackConstrState(Vars, z, ValAry) + type(SED_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call SED_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine SED_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(SED_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SED_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SED_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SED_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call SED_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine SED_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SED_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SED_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function SED_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SED_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine SED_VarsPackInput(Vars, u, ValAry) + type(SED_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call SED_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine SED_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(SED_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SED_u_HubPtLoad) + call MV_PackMesh(V, u%HubPtLoad, ValAry) ! Mesh + case (SED_u_HSSBrTrqC) + VarVals(1) = u%HSSBrTrqC ! Scalar + case (SED_u_GenTrq) + VarVals(1) = u%GenTrq ! Scalar + case (SED_u_BlPitchCom) + VarVals = u%BlPitchCom(V%iLB:V%iUB) ! Rank 1 Array + case (SED_u_YawPosCom) + VarVals(1) = u%YawPosCom ! Scalar + case (SED_u_YawRateCom) + VarVals(1) = u%YawRateCom ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SED_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SED_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call SED_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine SED_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SED_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SED_u_HubPtLoad) + call MV_UnpackMesh(V, ValAry, u%HubPtLoad) ! Mesh + case (SED_u_HSSBrTrqC) + u%HSSBrTrqC = VarVals(1) ! Scalar + case (SED_u_GenTrq) + u%GenTrq = VarVals(1) ! Scalar + case (SED_u_BlPitchCom) + u%BlPitchCom(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SED_u_YawPosCom) + u%YawPosCom = VarVals(1) ! Scalar + case (SED_u_YawRateCom) + u%YawRateCom = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function SED_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SED_u_HubPtLoad) + Name = "u%HubPtLoad" + case (SED_u_HSSBrTrqC) + Name = "u%HSSBrTrqC" + case (SED_u_GenTrq) + Name = "u%GenTrq" + case (SED_u_BlPitchCom) + Name = "u%BlPitchCom" + case (SED_u_YawPosCom) + Name = "u%YawPosCom" + case (SED_u_YawRateCom) + Name = "u%YawRateCom" + case default + Name = "Unknown Field" + end select +end function + +subroutine SED_VarsPackOutput(Vars, y, ValAry) + type(SED_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call SED_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine SED_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(SED_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SED_y_BladeRootMotion) + call MV_PackMesh(V, y%BladeRootMotion(DL%i1), ValAry) ! Mesh + case (SED_y_HubPtMotion) + call MV_PackMesh(V, y%HubPtMotion, ValAry) ! Mesh + case (SED_y_NacelleMotion) + call MV_PackMesh(V, y%NacelleMotion, ValAry) ! Mesh + case (SED_y_TowerLn2Mesh) + call MV_PackMesh(V, y%TowerLn2Mesh, ValAry) ! Mesh + case (SED_y_PlatformPtMesh) + call MV_PackMesh(V, y%PlatformPtMesh, ValAry) ! Mesh + case (SED_y_LSSTipPxa) + VarVals(1) = y%LSSTipPxa ! Scalar + case (SED_y_RotSpeed) + VarVals(1) = y%RotSpeed ! Scalar + case (SED_y_RotPwr) + VarVals(1) = y%RotPwr ! Scalar + case (SED_y_RotTrq) + VarVals(1) = y%RotTrq ! Scalar + case (SED_y_HSS_Spd) + VarVals(1) = y%HSS_Spd ! Scalar + case (SED_y_Yaw) + VarVals(1) = y%Yaw ! Scalar + case (SED_y_YawRate) + VarVals(1) = y%YawRate ! Scalar + case (SED_y_BlPitch) + VarVals = y%BlPitch(V%iLB:V%iUB) ! Rank 1 Array + case (SED_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SED_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SED_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call SED_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine SED_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SED_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SED_y_BladeRootMotion) + call MV_UnpackMesh(V, ValAry, y%BladeRootMotion(DL%i1)) ! Mesh + case (SED_y_HubPtMotion) + call MV_UnpackMesh(V, ValAry, y%HubPtMotion) ! Mesh + case (SED_y_NacelleMotion) + call MV_UnpackMesh(V, ValAry, y%NacelleMotion) ! Mesh + case (SED_y_TowerLn2Mesh) + call MV_UnpackMesh(V, ValAry, y%TowerLn2Mesh) ! Mesh + case (SED_y_PlatformPtMesh) + call MV_UnpackMesh(V, ValAry, y%PlatformPtMesh) ! Mesh + case (SED_y_LSSTipPxa) + y%LSSTipPxa = VarVals(1) ! Scalar + case (SED_y_RotSpeed) + y%RotSpeed = VarVals(1) ! Scalar + case (SED_y_RotPwr) + y%RotPwr = VarVals(1) ! Scalar + case (SED_y_RotTrq) + y%RotTrq = VarVals(1) ! Scalar + case (SED_y_HSS_Spd) + y%HSS_Spd = VarVals(1) ! Scalar + case (SED_y_Yaw) + y%Yaw = VarVals(1) ! Scalar + case (SED_y_YawRate) + y%YawRate = VarVals(1) ! Scalar + case (SED_y_BlPitch) + y%BlPitch(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SED_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function SED_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SED_y_BladeRootMotion) + Name = "y%BladeRootMotion("//trim(Num2LStr(DL%i1))//")" + case (SED_y_HubPtMotion) + Name = "y%HubPtMotion" + case (SED_y_NacelleMotion) + Name = "y%NacelleMotion" + case (SED_y_TowerLn2Mesh) + Name = "y%TowerLn2Mesh" + case (SED_y_PlatformPtMesh) + Name = "y%PlatformPtMesh" + case (SED_y_LSSTipPxa) + Name = "y%LSSTipPxa" + case (SED_y_RotSpeed) + Name = "y%RotSpeed" + case (SED_y_RotPwr) + Name = "y%RotPwr" + case (SED_y_RotTrq) + Name = "y%RotTrq" + case (SED_y_HSS_Spd) + Name = "y%HSS_Spd" + case (SED_y_Yaw) + Name = "y%Yaw" + case (SED_y_YawRate) + Name = "y%YawRate" + case (SED_y_BlPitch) + Name = "y%BlPitch" + case (SED_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE SED_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index c9c62ed92c..48c846e38d 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -46,7 +46,6 @@ Module SubDyn PUBLIC :: SD_JacobianPInput ! PUBLIC :: SD_JacobianPDiscState ! PUBLIC :: SD_JacobianPConstrState ! - PUBLIC :: SD_GetOP ! PUBLIC :: SD_ProgDesc CONTAINS @@ -416,9 +415,8 @@ SUBROUTINE SD_Init( InitInput, u, p, x, xd, z, OtherState, y, m, Interval, InitO CALL SDOUT_OpenOutput( SD_ProgDesc, Init%RootName, p, InitOut, ErrStat2, ErrMsg2 ); if(Failed()) return END IF - if (InitInput%Linearize) then - call SD_Init_Jacobian(Init, p, u, y, InitOut, ErrStat2, ErrMsg2); if(Failed()) return - endif + ! Initialize module variables + call SD_InitVars(InitOut%Vars, Init, u, p, x, y, m, InitOut, InitInput%Linearize, ErrStat2, ErrMsg2); if(Failed()) return ! Tell GLUECODE the SubDyn timestep interval Interval = p%SDdeltaT @@ -443,6 +441,103 @@ END SUBROUTINE CleanUp END SUBROUTINE SD_Init +!---------------------------------------------------------------------------------------------------------------------------------- +!> SD_InitVars initializes the variables for this module for use by the solver and linearization +subroutine SD_InitVars(Vars, Init, u, p, x, y, m, InitOut, Linearize, ErrStat, ErrMsg) + type(ModVarsType), intent(out) :: Vars !< Module variables + type(SD_InitType), intent(in) :: Init !< Input data for initialization routine + type(SD_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(SD_ParameterType), intent(inout) :: p !< Parameters + type(SD_ContinuousStateType), intent(inout) :: x !< Continuous State + type(SD_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(SD_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(SD_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'Init_ModuleVars' + INTEGER(IntKi) :: ErrStat2 ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + + integer(IntKi) :: i, j + real(R8Ki) :: dx, dy, dz, maxDim + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + call MV_AddVar(Vars%x, "Modes", FieldScalar, DatLoc(SD_x_qm), & + Num=p%nDOFM, & + DerivOrder=0, & + Perturb=2.0_ReKi*D2R_D, & + LinNames=[('Craig-Bampton mode '//trim(num2lstr(i))//' amplitude, -', i=1, p%nDOFM)]) + + call MV_AddVar(Vars%x, "Modes", FieldScalar, DatLoc(SD_x_qmdot), & + Num=p%nDOFM, & + DerivOrder=1, & + Perturb=2.0_ReKi*D2R_D, & + LinNames=[('First time derivative of Craig-Bampton mode '//trim(num2lstr(i))//' amplitude, -/s', i=1, p%nDOFM)]) + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + dx = maxval(Init%Nodes(:,2))- minval(Init%Nodes(:,2)) + dy = maxval(Init%Nodes(:,3))- minval(Init%Nodes(:,3)) + dz = maxval(Init%Nodes(:,4))- minval(Init%Nodes(:,4)) + maxDim = max(dx, dy, dz) + + call MV_AddMeshVar(Vars%u, "TPMesh", MotionFields, DatLoc(SD_u_TPMesh), & + Mesh=u%TPMesh, & + Perturbs=[2.0_R8Ki*D2R_D, & ! TranslationDisp + 2.0_R8Ki*D2R_D, & ! Orientation + 2.0_R8Ki*D2R_D, & ! TranslationVel + 2.0_R8Ki*D2R_D, & ! RotationVel + 2.0_R8Ki*D2R_D, & ! TranslationAcc + 2.0_R8Ki*D2R_D]) ! RotationAcc + + call MV_AddMeshVar(Vars%u, "LMesh", LoadFields, DatLoc(SD_u_LMesh), & + Mesh=u%LMesh, & + Perturbs=[170*maxDim**2, 14*maxDim**3]) ! Force, Moment + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + ! Mesh variables + call MV_AddMeshVar(Vars%y, 'Y1Mesh', LoadFields, DatLoc(SD_y_Y1Mesh), Mesh=y%Y1Mesh) + call MV_AddMeshVar(Vars%y, 'Y2Mesh', MotionFields, DatLoc(SD_y_Y2Mesh), Mesh=y%Y2Mesh) + call MV_AddMeshVar(Vars%y, 'Y3Mesh', MotionFields, DatLoc(SD_y_Y3Mesh), Mesh=y%Y3Mesh) + + ! Output variables + call MV_AddVar(Vars%y, "WriteOutput", FieldScalar, DatLoc(SD_y_WriteOutput), & + Num=p%NumOuts, & + Flags=VF_WriteOut, & + LinNames=[(WriteOutputLinName(i), i = 1, p%numOuts)]) + + !---------------------------------------------------------------------------- + ! Initialize Variables and Values + !---------------------------------------------------------------------------- + + CALL MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + call SD_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SD_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SD_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SD_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + +contains + character(LinChanLen) function WriteOutputLinName(idx) + integer(IntKi), intent(in) :: idx + WriteOutputLinName = trim(InitOut%WriteOutputHdr(idx))//', '//trim(InitOut%WriteOutputUnt(idx)) + end function + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- !> Loose coupling routine for solving for constraint states, integrating continuous states, and updating discrete and other states. !! Continuous, discrete, constraint, and other states are updated for t + Interval. @@ -500,7 +595,7 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) !locals INTEGER(IntKi) :: I ! Counters INTEGER(IntKi) :: iSDNode - REAL(ReKi) :: rotations(3) + REAL(R8Ki) :: rotations(3) REAL(ReKi) :: Y1(6) REAL(ReKi) :: Y1_CB(6) REAL(ReKi) :: Y1_CB_L(6) @@ -509,11 +604,9 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) REAL(ReKi) :: Y1_Utp(6) REAL(ReKi) :: Y1_GuyanLoadCorrection(3) ! Lever arm moment contributions due to interface displacement REAL(ReKi) :: udotdot_TP(6) - INTEGER(IntKi), pointer :: DOFList(:) - REAL(ReKi) :: DCM(3,3) + REAL(R8Ki) :: DCM(3,3) REAL(ReKi) :: MBB(6,6), CBB(6,6) ! Guyan mode inertia and damping matrices transformed to earth-fixed frame of reference REAL(ReKi) :: F_I(6*p%nNodes_I) ! !Forces from all interface nodes listed in one big array ( those translated to TP ref point HydroTP(6) are implicitly calculated in the equations) - TYPE(SD_ContinuousStateType) :: dxdt ! Continuous state derivatives at t- for output file qmdotdot purposes only ! Variables for Guyan rigid body motion real(ReKi), dimension(3) :: Om, OmD ! Omega, OmegaDot (body rotational speed and acceleration) real(ReKi), dimension(3) :: rIP ! Vector from TP to rotated Node @@ -540,7 +633,7 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ! Need to be small angles due to the Guyan stiffness terms rotations = GetSmllRotAngs(u%TPMesh%Orientation(:,:,1), ErrStat2, ErrMsg2); if(Failed()) return END IF - m%u_TP = (/REAL(u%TPMesh%TranslationDisp(:,1),ReKi), rotations/) + m%u_TP = (/u%TPMesh%TranslationDisp(:,1), rotations/) m%udot_TP = (/u%TPMesh%TranslationVel( :,1), u%TPMesh%RotationVel(:,1)/) m%udotdot_TP = (/u%TPMesh%TranslationAcc( :,1), u%TPMesh%RotationAcc(:,1)/) Rg2b(1:3,1:3) = u%TPMesh%Orientation(:,:,1) ! global 2 body coordinates @@ -621,7 +714,7 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) Om(1:3) = u%TPMesh%RotationVel(1:3,1) OmD(1:3) = u%TPMesh%RotationAcc(1:3,1) do iSDNode = 1,p%nNodes - DOFList => p%NodesDOF(iSDNode)%List ! Alias to shorten notations + associate (DOFList => p%NodesDOF(iSDNode)%List) ! Alias to shorten notations ! --- Guyan (rigid body) motion in global coordinates rIP0(1:3) = p%DP0(1:3, iSDNode) rIP(1:3) = matmul(Rb2g, rIP0) @@ -664,11 +757,12 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) y%Y2mesh%TranslationAcc (:,iSDNode) = m%U_full_dotdot (DOFList(1:3)) y%Y2mesh%RotationVel (:,iSDNode) = m%U_full_dot (DOFList(4:6)) y%Y2mesh%RotationAcc (:,iSDNode) = m%U_full_dotdot (DOFList(4:6)) + end associate enddo else ! --- Fixed bottom - Y3 and Y2 meshes are identical in this case do iSDNode = 1,p%nNodes - DOFList => p%NodesDOF(iSDNode)%List ! Alias to shorten notations + associate(DOFList => p%NodesDOF(iSDNode)%List) ! Alias to shorten notations ! TODO TODO which orientation to give for joints with more than 6 dofs? ! Construct the direction cosine matrix given the output angles CALL SmllRotTrans( 'UR_bar input angles', m%U_full_NS(DOFList(4)), m%U_full_NS(DOFList(5)), m%U_full_NS(DOFList(6)), DCM, '', ErrStat2, ErrMsg2); if(Failed()) return @@ -678,18 +772,17 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) y%Y2mesh%TranslationAcc (:,iSDNode) = m%U_full_dotdot (DOFList(1:3)) y%Y2mesh%RotationVel (:,iSDNode) = m%U_full_dot (DOFList(4:6)) y%Y2mesh%RotationAcc (:,iSDNode) = m%U_full_dotdot (DOFList(4:6)) - y%Y3mesh%TranslationDisp (:,iSDNode) = y%Y2mesh%TranslationDisp (:,iSDNode) - y%Y3mesh%Orientation (:,:,iSDNode) = y%Y2mesh%Orientation (:,:,iSDNode) + end associate enddo + y%Y3mesh%TranslationDisp = y%Y2mesh%TranslationDisp + y%Y3mesh%Orientation = y%Y2mesh%Orientation endif ! --- Y3 mesh and Y2 mesh both have elastic (Guyan+CB) velocities and accelerations - do iSDNode = 1,p%nNodes - y%Y3mesh%TranslationVel (:,iSDNode) = y%Y2mesh%TranslationVel (:,iSDNode) - y%Y3mesh%TranslationAcc (:,iSDNode) = y%Y2mesh%TranslationAcc (:,iSDNode) - y%Y3mesh%RotationVel (:,iSDNode) = y%Y2mesh%RotationVel (:,iSDNode) - y%Y3mesh%RotationAcc (:,iSDNode) = y%Y2mesh%RotationAcc (:,iSDNode) - enddo + y%Y3mesh%TranslationVel = y%Y2mesh%TranslationVel + y%Y3mesh%TranslationAcc = y%Y2mesh%TranslationAcc + y%Y3mesh%RotationVel = y%Y2mesh%RotationVel + y%Y3mesh%RotationAcc = y%Y2mesh%RotationAcc ! -------------------------------------------------------------------------------- ! --- Outputs 1, Y1=-F_TP, reaction force from SubDyn to ElastoDyn (stored in y%Y1Mesh) @@ -810,11 +903,9 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) !find xdot at t IF ( p%nDOFM > 0 ) THEN ! note that this re-sets m%udotdot_TP and m%F_L, but they are the same values as earlier in this routine so it doesn't change results in SDOut_MapOutputs() - CALL SD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrStat2, ErrMsg2 ); if(Failed()) return + CALL SD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2 ); if(Failed()) return !Assign the acceleration to the x variable since it will be used for output file purposes for SSqmdd01-99, and dxdt will disappear - m%qmdotdot=dxdt%qmdot - ! Destroy dxdt because it is not necessary for the rest of the subroutine - CALL SD_DestroyContState( dxdt, ErrStat2, ErrMsg2); if(Failed()) return + m%qmdotdot = m%dxdt_lin%qmdot END IF ! 6-vectors (making sure they are up to date for outputs m%udot_TP = (/u%TPMesh%TranslationVel(:,1),u%TPMesh%RotationVel(:,1)/) @@ -847,12 +938,7 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) LOGICAL FUNCTION Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_CalcOutput') Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() END FUNCTION Failed - - SUBROUTINE CleanUp - CALL SD_DestroyContState( dxdt, ErrStat2, ErrMsg2) - END SUBROUTINE CleanUp END SUBROUTINE SD_CalcOutput @@ -868,7 +954,7 @@ SUBROUTINE SD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta TYPE(SD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t TYPE(SD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t TYPE(SD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - TYPE(SD_ContinuousStateType), INTENT( OUT) :: dxdt !< Continuous state derivatives at t + TYPE(SD_ContinuousStateType), INTENT(INOUT) :: dxdt !< Continuous state derivatives at t INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None REAL(ReKi) :: udotdot_TP(6) @@ -877,12 +963,6 @@ SUBROUTINE SD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" - - ! INTENT(OUT) automatically deallocates the arrays on entry, we have to allocate them here - CALL AllocAry(dxdt%qm, p%nDOFM, 'dxdt%qm', ErrStat2, ErrMsg2 ); CALL SetErrStat ( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_CalcContStateDeriv' ) - CALL AllocAry(dxdt%qmdot, p%nDOFM, 'dxdt%qmdot', ErrStat2, ErrMsg2 ); CALL SetErrStat ( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_CalcContStateDeriv' ) - IF ( ErrStat >= AbortErrLev ) RETURN - IF ( p%nDOFM == 0 ) RETURN ! Compute F_L, force on internal DOF CALL GetExtForceOnInternalDOF(u, p, x, m, m%F_L, ErrStat2, ErrMsg2, GuyanLoadCorrection=(p%GuyanLoadCorrection.and..not.p%Floating), RotateLoads=(p%GuyanLoadCorrection.and.p%Floating)) @@ -2028,7 +2108,8 @@ END SUBROUTINE SD_AM2 !---------------------------------------------------------------------------------------------------------------------------------- !> 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 SD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +SUBROUTINE SD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(SD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(SD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -2044,103 +2125,109 @@ SUBROUTINE SD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) wrt the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) wrt the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) wrt the inputs (u) [intent in to avoid deallocation] - ! local variables - TYPE(SD_OutputType) :: y_m, y_p - TYPE(SD_ContinuousStateType) :: x_m, x_p - TYPE(SD_InputType) :: u_perturb - REAL(R8Ki) :: delta_p, delta_m ! delta change in input (plus, minus) - INTEGER(IntKi) :: i - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SD_JacobianPInput' - ! Initialize ErrStat + + character(*), parameter :: RoutineName = 'SD_JacobianPInput' + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, k, col + ErrStat = ErrID_None ErrMsg = '' - ! get OP values here: - call SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ); if(Failed()) return - ! make a copy of the inputs to perturb - call SD_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - IF ( PRESENT( dYdu ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: - if (.not. allocated(dYdu) ) then - call AllocAry(dYdu,p%Jac_ny, size(p%Jac_u_indx,1),'dYdu', ErrStat2, ErrMsg2); if(Failed()) return + + ! Calculate OP values here + call SD_CalcOutput(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ); if(Failed()) return + + ! Make a copy of the inputs to perturb + call SD_CopyInput(u, m%u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if(Failed()) return + call SD_VarsPackInput(Vars, u, m%Jac%u) + + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + if (present(dYdu)) then + + if (.not. allocated(dYdu)) then + call AllocAry(dYdu, m%Jac%Ny, m%Jac%Nu, 'dYdu', ErrStat2, ErrMsg2); if(Failed()) return end if - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call SD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - call SD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - do i=1,size(p%Jac_u_indx,1) - ! get u_op + delta_p u - call SD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_Perturb_u( p, i, 1, u_perturb, delta_p ) - ! compute y at u_op + delta_p u - call SD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get u_op - delta_m u - call SD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_Perturb_u( p, i, -1, u_perturb, delta_m ) - ! compute y at u_op - delta_m u - call SD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get central difference: - call SD_Compute_dY( p, y_p, y_m, delta_p, dYdu(:,i) ) + + ! Loop through input variables + do i = 1, size(Vars%u) + + ! Loop through number of linearization perturbations in variable + do j = 1,Vars%u(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call SD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call SD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call SD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call SD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call SD_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call SD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) + + ! Calculate column index + col = Vars%u(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference + call MV_ComputeCentralDiff(Vars%y, Vars%u(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdu(:,col)) + end do end do - if(Failed()) return - END IF - IF ( PRESENT( dXdu ) ) THEN - ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: - ! TODO: dXdu should be constant, in theory we dont' need to recompute it - !if(ANALYTICAL_LIN) then - ! Analytical lin cannot be used anymore with extra mom - ! call StateMatrices(p, ErrStat2, ErrMsg2, BB=dXdu); if(Failed()) return ! Allocation occurs in function - !else - if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%Jac_nx * 2, size(p%Jac_u_indx,1), 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return - endif - do i=1,size(p%Jac_u_indx,1) - ! get u_op + delta u - call SD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_Perturb_u( p, i, 1, u_perturb, delta_p ) - ! compute x at u_op + delta u - call SD_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get u_op - delta u - call SD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_Perturb_u( p, i, -1, u_perturb, delta_m ) - ! compute x at u_op - delta u - call SD_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get central difference: - ! we may have had an error allocating memory, so we'll check - if(Failed()) return - ! get central difference: - call SD_Compute_dX( p, x_p, x_m, delta_p, dXdu(:,i) ) + end if + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + if (present(dXdu) .and. (m%Jac%Nx > 0)) then + + if (.not. allocated(dXdu)) then + call AllocAry(dXdu, m%Jac%Nx, m%Jac%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return + endif + + ! Loop through input variables + do i = 1,size(Vars%u) + + ! Loop through number of linearization perturbations in variable + do j = 1,Vars%u(i)%Num + + ! Calculate positive perturbation and resulting continuous state derivatives + call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) + call SD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call SD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call SD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_pos) + + ! Calculate negative perturbation and resulting continuous state derivatives + call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) + call SD_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) + call SD_CalcContStateDeriv(t, m%u_perturb, p, x, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call SD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_neg) + + ! Calculate column index + col = Vars%u(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference + dXdu(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%u(i)%Perturb) end do - !endif ! analytical or numerical - END IF ! dXdu - IF ( PRESENT( dXddu ) ) THEN + end do + end if + + if (present(dXddu)) then if (allocated(dXddu)) deallocate(dXddu) - END IF - IF ( PRESENT( dZdu ) ) THEN + end if + + if (present(dZdu)) then if (allocated(dZdu)) deallocate(dZdu) - END IF - call CleanUp() -contains + end if +contains logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev end function Failed - - subroutine CleanUp() - call SD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call SD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - call SD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call SD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call SD_DestroyInput(u_perturb, ErrStat2, ErrMsg2 ) - end subroutine cleanup - END SUBROUTINE SD_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE SD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx) +SUBROUTINE SD_JacobianPContState(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx) + TYPE(ModVarsType), INTENT(IN ) :: Vars !< Module variables REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(SD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(SD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -2156,103 +2243,116 @@ SUBROUTINE SD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) wrt the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) wrt the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) wrt the continuous states (x) [intent in to avoid deallocation] - ! local variables - TYPE(SD_OutputType) :: y_p, y_m - TYPE(SD_ContinuousStateType) :: x_p, x_m - TYPE(SD_ContinuousStateType) :: x_perturb - REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, k - INTEGER(IntKi) :: idx - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_JacobianPContState' + + character(*), parameter :: RoutineName = 'SD_JacobianPContState' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, k, col + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' + + ! If no state variables, return + if (m%Jac%Nx == 0) return + ! make a copy of the continuous states to perturb NOTE: MESH_NEWCOPY - call SD_CopyContState( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - IF ( PRESENT( dYdx ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + call SD_CopyContState(x, m%x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if(Failed()) return + call SD_VarsPackContState(Vars, x, m%Jac%x) + + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + if (present(dYdx)) then + + ! Allocate dYdx if not allocated if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Jac_ny, p%Jac_nx*2, 'dYdx', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(dYdx, m%Jac%Ny, m%Jac%Nx, 'dYdx', ErrStat2, ErrMsg2); if(Failed()) return end if - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call SD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - idx = 1 - do k=1,2 ! 1=disp, 2=veloc - do i=1,p%Jac_nx ! CB mode - ! get x_op + delta x - call SD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_perturb_x(p, k, i, 1, x_perturb, delta ) - ! compute y at x_op + delta x - call SD_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get x_op - delta x - call SD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_perturb_x(p, k, i, -1, x_perturb, delta ) - ! compute y at x_op - delta x - call SD_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get central difference: - call SD_Compute_dY( p, y_p, y_m, delta, dYdx(:,idx) ) - idx = idx+1 + + ! Loop through state variables + do i = 1,size(Vars%x) + + ! Loop through number of linearization perturbations in variable + do j = 1,Vars%x(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call SD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call SD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call SD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call SD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call SD_CalcOutput(t, u, p, m%x_perturb, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call SD_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) + + ! Calculate column index + col = Vars%x(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference and store in full linearization array + call MV_ComputeCentralDiff(Vars%y, Vars%x(i)%Perturb, m%Jac%y_pos, m%Jac%y_neg, dYdx(:,col)) end do end do - if(Failed()) return - END IF - IF ( PRESENT( dXdx ) ) THEN - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: - ! TODO: dXdx should be constant, in theory we don't need to recompute it - if(ANALYTICAL_LIN) then - call StateMatrices(p, ErrStat2, ErrMsg2, AA=dXdx); if(Failed()) return ! Allocation occurs in function + end if + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + ! TODO: dXdx should be constant, in theory we don't need to recompute it + if (present(dXdx)) then + + ! If analytical linearization is enabled + if (ANALYTICAL_LIN) then + + ! Calculate dXdx as state matrix, allocation occurs in function + call StateMatrices(p, ErrStat2, ErrMsg2, AA=dXdx); if(Failed()) return + else + + ! Allocate dXdx if not allocated if (.not. allocated(dXdx)) then - call AllocAry(dXdx, p%Jac_nx * 2, p%Jac_nx * 2, 'dXdx', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(dXdx, m%Jac%Nx, m%Jac%Nx, 'dXdx', ErrStat2, ErrMsg2); if(Failed()) return end if - idx = 1 ! counter into dXdx - do k=1,2 ! 1=positions (x_perturb%q); 2=velocities (x_perturb%dqdt) - do i=1,p%Jac_nx - ! get x_op + delta x - call SD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_perturb_x(p, k, i, 1, x_perturb, delta ) - ! compute x at x_op + delta x - call SD_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get x_op - delta x - call SD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_perturb_x(p, k, i, -1, x_perturb, delta ) - ! compute x at x_op - delta x - call SD_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if(Failed()) return - ! get central difference: - call SD_Compute_dX( p, x_p, x_m, delta, dXdx(:,idx) ) - idx = idx+1 + + ! Loop through state variables + do i = 1,size(Vars%x) + + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%x(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(Vars%x(i), j, 1, m%Jac%x, m%Jac%x_perturb) + call SD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call SD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call SD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_pos) + + ! Calculate negative perturbation + call MV_Perturb(Vars%x(i), j, -1, m%Jac%x, m%Jac%x_perturb) + call SD_VarsUnpackContState(Vars, m%Jac%x_perturb, m%x_perturb) + call SD_CalcContStateDeriv(t, u, p, m%x_perturb, xd, z, OtherState, m, m%dxdt_lin, ErrStat2, ErrMsg2); if (Failed()) return + call SD_VarsPackContState(Vars, m%dxdt_lin, m%Jac%x_neg) + + ! Calculate column index + col = Vars%x(i)%iLoc(1) + j - 1 + + ! Get partial derivative via central difference and store in full linearization array + dXdx(:,col) = (m%Jac%x_pos - m%Jac%x_neg) / (2.0_R8Ki * Vars%x(i)%Perturb) end do end do endif ! analytical or numerical - END IF - IF ( PRESENT( dXddx ) ) THEN + end if + + if (present(dXddx)) then if (allocated(dXddx)) deallocate(dXddx) - END IF - IF ( PRESENT( dZdx ) ) THEN + end if + + if (present(dZdx)) then if (allocated(dZdx)) deallocate(dZdx) - END IF - call CleanUp() + end if contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_JacobianPContState') + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() end function Failed - - subroutine CleanUp() - call SD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call SD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call SD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call SD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) - call SD_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) - end subroutine cleanup - END SUBROUTINE SD_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- @@ -2321,130 +2421,7 @@ SUBROUTINE SD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat IF ( PRESENT(dZdz) ) THEN END IF END SUBROUTINE SD_JacobianPConstrState -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE SD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, NeedTrimOP ) - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(SD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(SD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(SD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(SD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(SD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(SD_OutputType), INTENT(IN ) :: y !< Output at operating point - TYPE(SD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - LOGICAL, OPTIONAL, INTENT(IN ) :: NeedTrimOP !< whether a y_op values should contain values for trim solution (3-value representation instead of full orientation matrices, no rotation acc) - - ! Local - INTEGER(IntKi) :: idx, i - LOGICAL :: ReturnTrimOP - INTEGER(IntKi) :: nu - INTEGER(IntKi) :: ny - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_GetOP' - LOGICAL :: FieldMask(FIELDMASK_SIZE) - TYPE(SD_ContinuousStateType) :: dx ! derivative of continuous states at operating point - ErrStat = ErrID_None - ErrMsg = '' - IF ( PRESENT( u_op ) ) THEN - nu = size(p%Jac_u_indx,1) + u%TPMesh%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM (thus 6 more per node) - if (.not. allocated(u_op)) then - call AllocAry(u_op, nu, 'u_op', ErrStat2, ErrMsg2); if(Failed()) return - end if - idx = 1 - FieldMask = .false. - FieldMask(MASKID_TranslationDisp) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TranslationVel) = .true. - FieldMask(MASKID_RotationVel) = .true. - FieldMask(MASKID_TranslationAcc) = .true. - FieldMask(MASKID_RotationAcc) = .true. - call PackMotionMesh(u%TPMesh, u_op, idx, FieldMask=FieldMask) - call PackLoadMesh(u%LMesh, u_op, idx) - END IF - - IF ( PRESENT( y_op ) ) THEN - ny = p%Jac_ny + y%Y2Mesh%NNodes * 6 + y%Y3Mesh%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 - call AllocAry(y_op, ny, 'y_op', ErrStat2, ErrMsg2); if(Failed()) return - end if - - if (present(NeedTrimOP)) then - ReturnTrimOP = NeedTrimOP - else - ReturnTrimOP = .false. - end if - - if (ReturnTrimOP) y_op = 0.0_ReKi ! initialize in case we are returning packed orientations and don't fill the entire array - - idx = 1 - call PackLoadMesh(y%Y1Mesh, y_op, idx) - FieldMask = .false. - FieldMask(MASKID_TranslationDisp) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TranslationVel) = .true. - FieldMask(MASKID_RotationVel) = .true. - FieldMask(MASKID_TranslationAcc) = .true. - FieldMask(MASKID_RotationAcc) = .true. - call PackMotionMesh(y%Y2Mesh, y_op, idx, FieldMask=FieldMask, TrimOP=ReturnTrimOP) - call PackMotionMesh(y%Y3Mesh, y_op, idx, FieldMask=FieldMask, TrimOP=ReturnTrimOP) - idx = idx - 1 - do i=1,p%NumOuts - y_op(i+idx) = y%WriteOutput(i) - end do - END IF - - IF ( PRESENT( x_op ) ) THEN - if (.not. allocated(x_op)) then - call AllocAry(x_op, p%Jac_nx*2,'x_op',ErrStat2,ErrMsg2); if (Failed()) return - end if - do i=1, p%Jac_nx - x_op(i) = x%qm(i) - end do - do i=1, p%Jac_nx - x_op(i+p%nDOFM) = x%qmdot(i) - end do - END IF - IF ( PRESENT( dx_op ) ) THEN - if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%Jac_nx * 2,'dx_op',ErrStat2,ErrMsg2); if(failed()) return - end if - call SD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dx, ErrStat2, ErrMsg2 ) ; if(Failed()) return - idx = 1 - do i=1, p%Jac_nx - dx_op(i) = dx%qm(i) - end do - do i=1, p%Jac_nx - dx_op(i+p%nDOFM) = dx%qmdot(i) - end do - END IF - IF ( PRESENT( xd_op ) ) THEN - ! pass - END IF - IF ( PRESENT( z_op ) ) THEN - ! pass - END IF - call CleanUp() -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() - end function Failed - subroutine CleanUp() - call SD_DestroyContState(dx, ErrStat2, ErrMsg2); - end subroutine -END SUBROUTINE SD_GetOP !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !------------------------------------------------------------------------------------------------------ !> Perform Craig Bampton (CB) reduction and set parameters needed for States and Ouputs equations @@ -3158,11 +3135,14 @@ END SUBROUTINE PartitionDOFNodes !! This is a generic function, "x" can be used for displacements, velocities, accelerations !! m%U_red is only used as a intermediate storage SUBROUTINE ReducedToFull(p, m, xR_bar, xL, x_full) + use NWTC_LAPACK, only: LAPACK_GEMV TYPE(SD_ParameterType),target,INTENT(IN ) :: p !< Parameters TYPE(SD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables REAL(ReKi), DIMENSION(:), INTENT(IN ) :: xR_bar !< Values of "x" interface nodes (6xnI) REAL(ReKi), DIMENSION(:), INTENT(IN ) :: xL !< Values of "x" internal nodes - REAL(ReKi), DIMENSION(:), INTENT( OUT) :: x_full !< Values of "x" transferred to full vector of DOF + REAL(R8Ki), DIMENSION(:), INTENT( OUT) :: x_full !< Values of "x" transferred to full vector of DOF + integer(IntKi) :: ErrStat + character(ErrMsgLen) :: ErrMsg if (p%reduced) then ! Filling up full vector of reduced DOF m%U_red(p%IDI__) = xR_bar @@ -3170,7 +3150,9 @@ SUBROUTINE ReducedToFull(p, m, xR_bar, xL, x_full) m%U_red(p%IDC_Rb)= 0 ! NOTE: for now we don't have leader DOF at "C" (bottom) m%U_red(p%ID__F) = 0 ! Transfer to full - x_full = matmul(p%T_red, m%U_red) ! TODO use LAPACK, but T_red and U_red have different types... + ! x_full = matmul(p%T_red, m%U_red) + call LAPACK_GEMV('N', size(p%T_red, 1), size(p%T_red, 2), 1.0_R8Ki, p%T_red, & + size(p%T_red, 1), m%U_red, 1, 0.0_R8ki, x_full, 1) else ! We use U_full directly x_full(p%IDI__) = xR_bar @@ -3189,7 +3171,7 @@ SUBROUTINE LeverArm(u, p, x, m, DU_full, bGuyan, bElastic) TYPE(SD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables LOGICAL, INTENT(IN ) :: bGuyan !< include Guyan Contribution LOGICAL, INTENT(IN ) :: bElastic !< include Elastic contribution - REAL(ReKi), DIMENSION(:), INTENT( OUT) :: DU_full !< LeverArm in full system + REAL(R8Ki), DIMENSION(:), INTENT( OUT) :: DU_full !< LeverArm in full system !locals INTEGER(IntKi) :: iSDNode REAL(ReKi) :: rotations(3) @@ -3199,7 +3181,7 @@ SUBROUTINE LeverArm(u, p, x, m, DU_full, bGuyan, bElastic) real(ReKi), dimension(3) :: rIP0 ! Vector from TP to Node (undeflected) real(ReKi), dimension(3) :: duP ! Displacement of node due to rigid rotation real(R8Ki), dimension(3,3) :: Rb2g ! Rotation matrix body 2 global coordinates - real(ReKi), dimension(3,3) :: DCM + real(R8Ki), dimension(3,3) :: DCM INTEGER(IntKi) :: ErrStat2 ! Error status of the operation (occurs after initial error) CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None ! --- Convert inputs to FEM DOFs and convenient 6-vector storage @@ -3278,7 +3260,7 @@ SUBROUTINE GetExtForceOnInternalDOF(u, p, x, m, F_L, ErrStat, ErrMsg, GuyanLoadC real(ReKi), dimension(3) :: duP ! Displacement of node due to rigid rotation real(R8Ki), dimension(3,3) :: Rb2g ! Rotation matrix body 2 global real(R8Ki), dimension(3,3) :: Rg2b ! Rotation matrix global 2 body coordinates - real(ReKi), dimension(3,3) :: orientation ! Nodal orientation matrix + real(R8Ki), dimension(3,3) :: orientation ! Nodal orientation matrix INTEGER(IntKi) :: ErrStat2 ! Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None @@ -4285,7 +4267,8 @@ FUNCTION BeamMass(rho1,D1,t1,rho2,D2,t2,L,method) b0=rho1 b1=(rho2-rho1)/L !Here we will need to figure out what element it is for now circular pipes - IF (method<=0) THEN + select case (method) + case (:0) ! Mid values for r, t, and potentially rho r1 = 0.25_ReKi*(D1 + D2) t = 0.50_ReKi*(t1 + t2) @@ -4300,22 +4283,25 @@ FUNCTION BeamMass(rho1,D1,t1,rho2,D2,t2,L,method) else BeamMass = rho1 * L * Area ! WHAT is currently used by FEM endif - ELSEIF (method==1) THEN !circular tube + + case (1) ! circular tube a0=pi * (D1*t1-t1**2.) dt=t2-t1 !thickness variation dd=D2-D1 !OD variation a1=pi * ( dd*t1 + D1*dt -2.*t1*dt)/L a2=pi * ( dd*dt-dt**2.)/L**2. BeamMass = b0*a0*L +(a0*b1+b0*a1)*L**2/2. + (b0*a2+b1*a1)*L**3/3 + a2*b1*L**4/4.!Integral of rho*A dz - ELSEIF (method==2) THEN !linearly varying area + + case (2) ! linearly varying area a0=D1 !This is an area a1=(D2-D1)/L !Delta area a2=0. BeamMass = b0*a0*L +(a0*b1+b0*a1)*L**2/2. + (b0*a2+b1*a1)*L**3/3 + a2*b1*L**4/4.!Integral of rho*A dz - ELSE + + case default print*,'Wrong call to BeamMass, method unknown',method STOP - ENDIF + end select END FUNCTION BeamMass diff --git a/modules/subdyn/src/SubDyn_Output.f90 b/modules/subdyn/src/SubDyn_Output.f90 index 76d470711c..a59f3464d4 100644 --- a/modules/subdyn/src/SubDyn_Output.f90 +++ b/modules/subdyn/src/SubDyn_Output.f90 @@ -40,11 +40,6 @@ MODULE SubDyn_Output PUBLIC :: SDOut_WriteOutputUnits PUBLIC :: SDOut_WriteOutputs PUBLIC :: SDOut_Init - PUBLIC :: SD_Init_Jacobian - PUBLIC :: SD_Perturb_u - PUBLIC :: SD_Perturb_x - PUBLIC :: SD_Compute_dY - PUBLIC :: SD_Compute_dX CONTAINS @@ -832,245 +827,5 @@ SUBROUTINE SDOut_ChkOutLst( OutList, p, ErrStat, ErrMsg ) END SUBROUTINE SDOut_ChkOutLst !==================================================================================================== -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> This routine initializes the array that maps rows/columns of the Jacobian to specific mesh fields. -!! Do not change the order of this packing without changing subroutine ! -SUBROUTINE SD_Init_Jacobian(Init, p, u, y, InitOut, ErrStat, ErrMsg) - TYPE(SD_InitType) , INTENT(IN ) :: Init !< Init - TYPE(SD_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(SD_InputType) , INTENT(IN ) :: u !< inputs - TYPE(SD_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(SD_InitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) - 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 = 'SD_Init_Jacobian' - real(ReKi) :: dx, dy, dz, maxDim - ! local variables: - ErrStat = ErrID_None - ErrMsg = "" - ! --- System dimension - dx = maxval(Init%Nodes(:,2))- minval(Init%Nodes(:,2)) - dy = maxval(Init%Nodes(:,3))- minval(Init%Nodes(:,3)) - dz = maxval(Init%Nodes(:,4))- minval(Init%Nodes(:,4)) - maxDim = max(dx, dy, dz) - - ! --- System dimension - call Init_Jacobian_y(); if (Failed()) return - call Init_Jacobian_x(); if (Failed()) return - call Init_Jacobian_u(); if (Failed()) return - -contains - LOGICAL FUNCTION Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_Init_Jacobian') - Failed = ErrStat >= AbortErrLev - END FUNCTION Failed - !> This routine initializes the Jacobian parameters and initialization outputs for the linearized outputs. - - SUBROUTINE Init_Jacobian_y() - INTEGER(IntKi) :: index_next, i - ! Number of outputs - p%Jac_ny = y%Y1Mesh%nNodes * 6 & ! 3 forces + 3 moments at each node - + y%Y2Mesh%nNodes * 18 & ! 6 displacements + 6 velocities + 6 accelerations at each node - + y%Y3Mesh%nNodes * 18 & ! 6 displacements + 6 velocities + 6 accelerations at each node - + p%NumOuts ! WriteOutput values - ! Storage info for each output (names, rotframe) - call AllocAry(InitOut%LinNames_y, p%Jac_ny, 'LinNames_y',ErrStat2,ErrMsg2); if(ErrStat2/=ErrID_None) return - call AllocAry(InitOut%RotFrame_y, p%Jac_ny, 'RotFrame_y',ErrStat2,ErrMsg2); if(ErrStat2/=ErrID_None) return - ! Names - index_next = 1 - call PackLoadMesh_Names( y%Y1Mesh, 'Interface displacement', InitOut%LinNames_y, index_next) - call PackMotionMesh_Names(y%Y2Mesh, 'Nodes motion mixed' , InitOut%LinNames_y, index_next) - call PackMotionMesh_Names(y%Y3Mesh, 'Nodes motion full' , InitOut%LinNames_y, index_next) - do i=1,p%NumOuts - InitOut%LinNames_y(i+index_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) - end do - ! RotFrame - InitOut%RotFrame_y(:) = .false. - END SUBROUTINE Init_Jacobian_y - - !> This routine initializes the Jacobian parameters and initialization outputs for the linearized continuous states. - SUBROUTINE Init_Jacobian_x() - INTEGER(IntKi) :: i - p%Jac_nx = p%nDOFM ! qm - ! allocate space for the row/column names and for perturbation sizes - CALL AllocAry(InitOut%LinNames_x , 2*p%Jac_nx, 'LinNames_x' , ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return - CALL AllocAry(InitOut%RotFrame_x , 2*p%Jac_nx, 'RotFrame_x' , ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return - CALL AllocAry(InitOut%DerivOrder_x, 2*p%Jac_nx, 'DerivOrder_x', ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return - ! default perturbations, p%dx: - p%dx(1) = 2.0_ReKi*D2R_D ! deflection states in rad and rad/s - p%dx(2) = 2.0_ReKi*D2R_D ! deflection states in rad and rad/s - InitOut%RotFrame_x = .false. - InitOut%DerivOrder_x = 2 - ! set linearization output names: - do i=1,p%Jac_nx - InitOut%LinNames_x(i) = 'Craig-Bampton mode '//trim(num2lstr(i))//' amplitude, -'; - end do - do i=1,p%Jac_nx - InitOut%LinNames_x(i+p%Jac_nx) = 'First time derivative of '//trim(InitOut%LinNames_x(i))//'/s' - InitOut%RotFrame_x(i+p%Jac_nx) = InitOut%RotFrame_x(i) - end do - END SUBROUTINE Init_Jacobian_x - - SUBROUTINE Init_Jacobian_u() - REAL(R8Ki) :: perturb - INTEGER(IntKi) :: i, j, idx, nu, i_meshField - ! Number of inputs - nu = u%TPMesh%nNodes * 18 & ! 3 Translation Displacements + 3 orientations + 6 velocities + 6 accelerations at each node - + u%LMesh%nNodes * 6 ! 3 forces + 3 moments at each node - ! --- Info of linearized inputs (Names, RotFrame, IsLoad) - call AllocAry(InitOut%LinNames_u, nu, 'LinNames_u', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return - call AllocAry(InitOut%RotFrame_u, nu, 'RotFrame_u', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return - call AllocAry(InitOut%IsLoad_u , nu, 'IsLoad_u' , ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return - InitOut%RotFrame_u = .false. ! every input is on a mesh, which stores values in the global (not rotating) frame - idx = 1 - call PackMotionMesh_Names(u%TPMesh, 'TPMesh', InitOut%LinNames_u, idx) ! all 6 motion fields - InitOut%IsLoad_u(1:idx-1) = .false. ! the TPMesh inputs are not loads - InitOut%IsLoad_u(idx:) = .true. ! the remaining inputs are loads - call PackLoadMesh_Names( u%LMesh, 'LMesh', InitOut%LinNames_u, idx) - - ! --- Jac_u_indx: matrix to store index to help us figure out what the ith value of the u vector really means - ! (see perturb_u ... these MUST match ) - ! column 1 indicates module's mesh and field - ! column 2 indicates the first index (x-y-z component) of the field - ! column 3 is the node - call allocAry( p%Jac_u_indx, nu, 3, 'p%Jac_u_indx', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return - idx = 1 - !Module/Mesh/Field: u%TPMesh%TranslationDisp = 1; - !Module/Mesh/Field: u%TPMesh%Orientation = 2; - !Module/Mesh/Field: u%TPMesh%TranslationVel = 3; - !Module/Mesh/Field: u%TPMesh%RotationVel = 4; - !Module/Mesh/Field: u%TPMesh%TranslationAcc = 5; - !Module/Mesh/Field: u%TPMesh%RotationAcc = 6; - do i_meshField = 1,6 - do i=1,u%TPMesh%nNodes - do j=1,3 - p%Jac_u_indx(idx,1) = i_meshField - p%Jac_u_indx(idx,2) = j !component idx: j - p%Jac_u_indx(idx,3) = i !Node: i - idx = idx + 1 - end do !j - end do !i - end do - !Module/Mesh/Field: u%LMesh%Force = 7; - !Module/Mesh/Field: u%LMesh%Moment = 8; - do i_meshField = 7,8 - do i=1,u%LMesh%nNodes - do j=1,3 - p%Jac_u_indx(idx,1) = i_meshField - p%Jac_u_indx(idx,2) = j !component idx: j - p%Jac_u_indx(idx,3) = i !Node: i - idx = idx + 1 - end do !j - end do !i - end do - - ! --- Default perturbations, p%du: - call allocAry( p%du, 8, 'p%du', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return ! 8 = number of unique values in p%Jac_u_indx(:,1) - perturb = 2.0_R8Ki*D2R_D - p%du( 1) = perturb ! u%TPMesh%TranslationDisp = 1; - p%du( 2) = perturb ! u%TPMesh%Orientation = 2; - p%du( 3) = perturb ! u%TPMesh%TranslationVel = 3; - p%du( 4) = perturb ! u%TPMesh%RotationVel = 4; - p%du( 5) = perturb ! u%TPMesh%TranslationAcc = 5; - p%du( 6) = perturb ! u%TPMesh%RotationAcc = 6; - p%du( 7) = 170*maxDim**2 ! u%LMesh%Force = 7; - p%du( 8) = 14*maxDim**3 ! u%LMesh%Moment = 8; - END SUBROUTINE Init_Jacobian_u - -END SUBROUTINE SD_Init_Jacobian -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine beamdyn::init_jacobian is consistant with this routine! -SUBROUTINE SD_Perturb_u( p, n, perturb_sign, u, du ) - TYPE(SD_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(SD_InputType) , INTENT(INOUT) :: u !< perturbed SD inputs - REAL( R8Ki ) , INTENT( OUT) :: du !< amount that specific input was perturbed - ! local variables - INTEGER :: fieldIndx - INTEGER :: node - fieldIndx = p%Jac_u_indx(n,2) - node = p%Jac_u_indx(n,3) - du = p%du( p%Jac_u_indx(n,1) ) - ! determine which mesh we're trying to perturb and perturb the input: - SELECT CASE( p%Jac_u_indx(n,1) ) - CASE ( 1) !Module/Mesh/Field: u%TPMesh%TranslationDisp = 1; - u%TPMesh%TranslationDisp( fieldIndx,node) = u%TPMesh%TranslationDisp( fieldIndx,node) + du * perturb_sign - CASE ( 2) !Module/Mesh/Field: u%TPMesh%Orientation = 2; - CALL PerturbOrientationMatrix( u%TPMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.false. ) - CASE ( 3) !Module/Mesh/Field: u%TPMesh%TranslationVel = 3; - u%TPMesh%TranslationVel( fieldIndx,node) = u%TPMesh%TranslationVel( fieldIndx,node) + du * perturb_sign - CASE ( 4) !Module/Mesh/Field: u%TPMesh%RotationVel = 4; - u%TPMesh%RotationVel(fieldIndx,node) = u%TPMesh%RotationVel(fieldIndx,node) + du * perturb_sign - CASE ( 5) !Module/Mesh/Field: u%TPMesh%TranslationAcc = 5; - u%TPMesh%TranslationAcc( fieldIndx,node) = u%TPMesh%TranslationAcc( fieldIndx,node) + du * perturb_sign - CASE ( 6) !Module/Mesh/Field: u%TPMesh%RotationAcc = 6; - u%TPMesh%RotationAcc(fieldIndx,node) = u%TPMesh%RotationAcc(fieldIndx,node) + du * perturb_sign - CASE ( 7) !Module/Mesh/Field: u%LMesh%Force = 7; - u%LMesh%Force(fieldIndx,node) = u%LMesh%Force(fieldIndx,node) + du * perturb_sign - CASE ( 8) !Module/Mesh/Field: u%LMesh%Moment = 8; - u%LMesh%Moment(fieldIndx,node) = u%LMesh%Moment(fieldIndx,node) + du * perturb_sign - END SELECT -END SUBROUTINE SD_Perturb_u -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine beamdyn::init_jacobian is consistant with this routine! -SUBROUTINE SD_Compute_dY(p, y_p, y_m, delta, dY) - TYPE(SD_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(SD_OutputType) , INTENT(IN ) :: y_p !< SD outputs at \f$ u + \Delta_p u \f$ or \f$ z + \Delta_p z \f$ (p=plus) - TYPE(SD_OutputType) , INTENT(IN ) :: y_m !< SD outputs at \f$ u - \Delta_m u \f$ or \f$ z - \Delta_m z \f$ (m=minus) - REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta_p = \Delta_p u \f$ or \f$ delta_p = \Delta_p x \f$ - REAL(R8Ki) , INTENT(INOUT) :: dY(:) !< column of dYdu or dYdx: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial z_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ - ! local variables: - INTEGER(IntKi) :: i ! loop over outputs - INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled - indx_first = 1 - call PackLoadMesh_dY( y_p%Y1Mesh, y_m%Y1Mesh, dY, indx_first) - call PackMotionMesh_dY(y_p%Y2Mesh, y_m%Y2Mesh, dY, indx_first, UseSmlAngle=.false.) ! all 6 motion fields - call PackMotionMesh_dY(y_p%Y3Mesh, y_m%Y3Mesh, dY, indx_first, UseSmlAngle=.false.) ! all 6 motion fields - do i=1,p%NumOuts - dY(i+indx_first-1) = y_p%WriteOutput(i) - y_m%WriteOutput(i) - end do - dY = dY / (2.0_R8Ki*delta) -END SUBROUTINE SD_Compute_dY -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the x array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine sd_init_jacobian is consistant with this routine! -SUBROUTINE SD_Perturb_x( p, fieldIndx, mode, perturb_sign, x, dx ) - TYPE(SD_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: fieldIndx !< field in the state type: 1=displacements; 2=velocities - INTEGER( IntKi ) , INTENT(IN ) :: mode !< node number - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(SD_ContinuousStateType), INTENT(INOUT) :: x !< perturbed SD states - REAL( R8Ki ) , INTENT( OUT) :: dx !< amount that specific state was perturbed - if (fieldIndx==1) then - dx=p%dx(1) - x%qm(mode) = x%qm(mode) + dx * perturb_sign - else - dx=p%dx(2) - x%qmdot(mode) = x%qmdot(mode) + dx * perturb_sign - end if -END SUBROUTINE SD_Perturb_x -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine sd_init_jacobian is consistant with this routine! -SUBROUTINE SD_Compute_dX(p, x_p, x_m, delta, dX) - TYPE(SD_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(SD_ContinuousStateType), INTENT(IN ) :: x_p !< SD continuous states at \f$ u + \Delta_p u \f$ or \f$ x + \Delta_p x \f$ (p=plus) - TYPE(SD_ContinuousStateType), INTENT(IN ) :: x_m !< SD continuous states at \f$ u - \Delta_m u \f$ or \f$ x - \Delta_m x \f$ (m=minus) - REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta_p = \Delta_p u \f$ or \f$ delta_p = \Delta_p x \f$ - REAL(R8Ki) , INTENT(INOUT) :: dX(:) !< column of dXdu or dXdx: \f$ \frac{\partial X}{\partial u_i} = \frac{x_p - x_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial X}{\partial x_i} = \frac{x_p - x_m}{2 \, \Delta x}\f$ - INTEGER(IntKi) :: i ! loop over modes - do i=1,p%Jac_nx - dX(i) = x_p%qm(i) - x_m%qm(i) - end do - do i=1,p%Jac_nx - dX(p%Jac_nx+i) = x_p%qmdot(i) - x_m%qmdot(i) - end do - dX = dX / (2.0_R8Ki*delta) -END SUBROUTINE SD_Compute_dX END MODULE SubDyn_Output diff --git a/modules/subdyn/src/SubDyn_Registry.txt b/modules/subdyn/src/SubDyn_Registry.txt index 80af480766..c795507747 100644 --- a/modules/subdyn/src/SubDyn_Registry.txt +++ b/modules/subdyn/src/SubDyn_Registry.txt @@ -80,6 +80,7 @@ typedef ^ InitInputType Logical Linearize - .FALSE. - "Flag that 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" - +typedef ^ InitOutputType ModVarsType Vars - - - "Module Variables" # Linearization typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_x {:} - - "Names of the continuous states used in linearization" - @@ -159,43 +160,13 @@ typedef ^ ConstraintStateType ReKi DummyConstrState - - - "Remove this variab typedef ^ OtherStateType SD_ContinuousStateType xdot {:} - - "previous state derivs for m-step time integrator" typedef ^ ^ IntKi n - - - "tracks time step for which OtherState was updated last" -# ..... Misc/Optimization variables................................................................................................. -# Define any data that are used only for efficiency purposes (these variables are not associated with time): -# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. -typedef ^ MiscVarType ReKi qmdotdot {:} - - "2nd Derivative of states, used only for output-file purposes" -typedef ^ MiscVarType ReKi u_TP 6 - - -typedef ^ MiscVarType ReKi udot_TP 6 - - -typedef ^ MiscVarType ReKi udotdot_TP 6 - - -typedef ^ MiscVarType ReKi F_L {:} - - "Loads on internal DOF, size nL" -typedef ^ MiscVarType ReKi F_L2 {:} - - "Loads on internal DOF, size nL, used for SIM and ADM4" -typedef ^ MiscVarType ReKi UR_bar {:} - - -typedef ^ MiscVarType ReKi UR_bar_dot {:} - - -typedef ^ MiscVarType ReKi UR_bar_dotdot {:} - - -typedef ^ MiscVarType ReKi UL {:} - - "Internal DOFs (L) displacements " -typedef ^ MiscVarType ReKi UL_NS {:} - - "Internal DOFs (L) displacements, No SIM (NS)" -typedef ^ MiscVarType ReKi UL_dot {:} - - -typedef ^ MiscVarType ReKi UL_dotdot {:} - - -typedef ^ MiscVarType ReKi DU_full {:} - - "Delta U used for extra moment, size nDOF" -typedef ^ MiscVarType ReKi U_full {:} - - "Displacement of all DOFs (full system) with SIM" -typedef ^ MiscVarType ReKi U_full_NS {:} - - "Displacement of all DOFs (full system), No SIM (NS)" -typedef ^ MiscVarType ReKi U_full_dot {:} - - -typedef ^ MiscVarType ReKi U_full_dotdot {:} - - -typedef ^ MiscVarType ReKi U_full_elast {:} - - "Elastic displacements for computation of K ue (without rigid body mode for floating), includes SIM" -typedef ^ MiscVarType ReKi U_red {:} - - -typedef ^ MiscVarType ReKi FC_unit {:} - - "Cable Force vector (for varying cable load, of unit cable load)" N -typedef ^ MiscVarType ReKi SDWrOutput {:} - - "Data from previous step to be written to a SubDyn output file" -typedef ^ MiscVarType ReKi AllOuts {:} - - "Data for output file" -typedef ^ MiscVarType DbKi LastOutTime - - - "The time of the most recent stored output data" "s" -typedef ^ MiscVarType IntKi Decimat - - - "Current output decimation counter" "-" -typedef ^ MiscVarType ReKi Fext {:} - - "External loads on unconstrained DOFs" "-" -typedef ^ MiscVarType ReKi Fext_red {:} - - "External loads on constrained DOFs, Fext_red= T^t Fext" "-" -typedef ^ MiscVarType R8Ki FG {:} - - "Gravity force vector (without initial cable force T0) based on the instantaneous platform orientation, not reduced (floating only)" N -# SIM -typedef ^ MiscVarType ReKi UL_SIM {:} - - "UL for SIM = PhiL qL0- PhiM qm0, size nL" -typedef ^ MiscVarType ReKi UL_0m {:} - - "Intermediate UL term for SIM = PhiM qm0, size nL" -### data for writing to an output file (this data is associated with time, but saved/written in CalcOutput so not stored as an other state) ### - # ============================== Parameters ============================================================================================================================================ +typedef ^ ParameterType IntKi iVarTPMesh - 0 - "Variable index for TPMesh" +typedef ^ ParameterType IntKi iVarLMesh - 0 - "Variable index for LMesh" +typedef ^ ParameterType IntKi iVarY1Mesh - 0 - "Variable index for Y1Mesh" +typedef ^ ParameterType IntKi iVarY2Mesh - 0 - "Variable index for Y2Mesh" +typedef ^ ParameterType IntKi iVarY3Mesh - 0 - "Variable index for Y3Mesh" +typedef ^ ParameterType IntKi iVarWriteOutput - 0 - "Variable index for WriteOutput" # --- Parameters - Algo typedef ^ ParameterType ReKi g - - - "Gravity acceleration" m/s^2 typedef ^ ParameterType DbKi SDDeltaT - - - "Time step (for integration of continuous states)" seconds @@ -306,13 +277,6 @@ typedef ^ ParameterType LOGICAL OutReact - - - "Flag to check typedef ^ ParameterType IntKi OutAllInt - - - "Integer version of OutAll" typedef ^ ParameterType IntKi OutAllDims - - - "Integer version of OutAll" typedef ^ ParameterType IntKi OutDec - - - "Output Decimation for Requested Channels" -# --- Parametesr - Linearization -typedef ^ ParameterType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - -typedef ^ ParameterType R8Ki du {:} - - "vector that determines size of perturbation for u (inputs)" -typedef ^ ParameterType R8Ki dx {2} - - "vector that determines size of perturbation for x (continuous states)" -typedef ^ ParameterType Integer Jac_ny - - - "number of outputs in jacobian matrix" - -typedef ^ ParameterType Integer Jac_nx - - - "half the number of continuous states in jacobian matrix" - -typedef ^ ParameterType logical RotStates - - - "Orient states in rotating frame during linearization? (flag)" - # ============================== Inputs ============================================================================================================================================ typedef ^ InputType MeshType TPMesh - - - "Transition piece inputs on a point mesh" @@ -324,3 +288,45 @@ typedef ^ OutputType MeshType Y1Mesh - - - "Transition piece outp typedef ^ OutputType MeshType Y2Mesh - - - "Interior+Interface nodes rigid body displacements + elastic velocities and accelerations on a point mesh" typedef ^ OutputType MeshType Y3Mesh - - - "Interior+Interface nodes full elastic displacements/velocities and accelerations on a point mesh" typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file" + +# ============================== Misc/Optimization variables ======================================================================================================================== +# Define any data that are used only for efficiency purposes (these variables are not associated with time): +# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. +typedef ^ MiscVarType ModJacType Jac - - - "Values corresponding to module variables" +typedef ^ MiscVarType SD_ContinuousStateType x_perturb - - - "" +typedef ^ MiscVarType SD_ContinuousStateType dxdt_lin - - - "" +typedef ^ MiscVarType SD_InputType u_perturb - - - "" +typedef ^ MiscVarType SD_OutputType y_lin - - - "" +typedef ^ MiscVarType ReKi qmdotdot {:} - - "2nd Derivative of states, used only for output-file purposes" +typedef ^ MiscVarType ReKi u_TP 6 - - +typedef ^ MiscVarType ReKi udot_TP 6 - - +typedef ^ MiscVarType ReKi udotdot_TP 6 - - +typedef ^ MiscVarType ReKi F_L {:} - - "Loads on internal DOF, size nL" +typedef ^ MiscVarType ReKi F_L2 {:} - - "Loads on internal DOF, size nL, used for SIM and ADM4" +typedef ^ MiscVarType ReKi UR_bar {:} - - +typedef ^ MiscVarType ReKi UR_bar_dot {:} - - +typedef ^ MiscVarType ReKi UR_bar_dotdot {:} - - +typedef ^ MiscVarType ReKi UL {:} - - "Internal DOFs (L) displacements " +typedef ^ MiscVarType ReKi UL_NS {:} - - "Internal DOFs (L) displacements, No SIM (NS)" +typedef ^ MiscVarType ReKi UL_dot {:} - - +typedef ^ MiscVarType ReKi UL_dotdot {:} - - +typedef ^ MiscVarType R8Ki DU_full {:} - - "Delta U used for extra moment, size nDOF" +typedef ^ MiscVarType R8Ki U_full {:} - - "Displacement of all DOFs (full system) with SIM" +typedef ^ MiscVarType R8Ki U_full_NS {:} - - "Displacement of all DOFs (full system), No SIM (NS)" +typedef ^ MiscVarType R8Ki U_full_dot {:} - - +typedef ^ MiscVarType R8Ki U_full_dotdot {:} - - +typedef ^ MiscVarType R8Ki U_full_elast {:} - - "Elastic displacements for computation of K ue (without rigid body mode for floating), includes SIM" +typedef ^ MiscVarType R8Ki U_red {:} - - +typedef ^ MiscVarType R8Ki x_full {:} - - +typedef ^ MiscVarType ReKi FC_unit {:} - - "Cable Force vector (for varying cable load, of unit cable load)" N +typedef ^ MiscVarType ReKi SDWrOutput {:} - - "Data from previous step to be written to a SubDyn output file" +typedef ^ MiscVarType ReKi AllOuts {:} - - "Data for output file" +typedef ^ MiscVarType DbKi LastOutTime - - - "The time of the most recent stored output data" "s" +typedef ^ MiscVarType IntKi Decimat - - - "Current output decimation counter" "-" +typedef ^ MiscVarType ReKi Fext {:} - - "External loads on unconstrained DOFs" "-" +typedef ^ MiscVarType ReKi Fext_red {:} - - "External loads on constrained DOFs, Fext_red= T^t Fext" "-" +typedef ^ MiscVarType R8Ki FG {:} - - "Gravity force vector (without initial cable force T0) based on the instantaneous platform orientation, not reduced (floating only)" N +# SIM +typedef ^ MiscVarType ReKi UL_SIM {:} - - "UL for SIM = PhiL qL0- PhiM qm0, size nL" +typedef ^ MiscVarType ReKi UL_0m {:} - - "Intermediate UL term for SIM = PhiM qm0, size nL" +### data for writing to an output file (this data is associated with time, but saved/written in CalcOutput so not stored as an other state) ### diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index 6a539f1ab2..a8e15c6146 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -119,6 +119,7 @@ MODULE SubDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + TYPE(ModVarsType) :: Vars !< Module Variables [-] 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 [-] @@ -211,42 +212,14 @@ MODULE SubDyn_Types INTEGER(IntKi) :: n = 0_IntKi !< tracks time step for which OtherState was updated last [-] END TYPE SD_OtherStateType ! ======================= -! ========= SD_MiscVarType ======= - TYPE, PUBLIC :: SD_MiscVarType - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: qmdotdot !< 2nd Derivative of states, used only for output-file purposes [-] - REAL(ReKi) , DIMENSION(1:6) :: u_TP = 0.0_ReKi - REAL(ReKi) , DIMENSION(1:6) :: udot_TP = 0.0_ReKi - REAL(ReKi) , DIMENSION(1:6) :: udotdot_TP = 0.0_ReKi - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_L !< Loads on internal DOF, size nL [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_L2 !< Loads on internal DOF, size nL, used for SIM and ADM4 [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar_dot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar_dotdot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL !< Internal DOFs (L) displacements [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_NS !< Internal DOFs (L) displacements, No SIM (NS) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_dot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_dotdot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DU_full !< Delta U used for extra moment, size nDOF [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full !< Displacement of all DOFs (full system) with SIM [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_NS !< Displacement of all DOFs (full system), No SIM (NS) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_dot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_dotdot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_elast !< Elastic displacements for computation of K ue (without rigid body mode for floating), includes SIM [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_red - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FC_unit !< Cable Force vector (for varying cable load, of unit cable load) [N] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SDWrOutput !< Data from previous step to be written to a SubDyn output file [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< Data for output file [-] - REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< The time of the most recent stored output data [s] - INTEGER(IntKi) :: Decimat = 0_IntKi !< Current output decimation counter [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Fext !< External loads on unconstrained DOFs [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Fext_red !< External loads on constrained DOFs, Fext_red= T^t Fext [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: FG !< Gravity force vector (without initial cable force T0) based on the instantaneous platform orientation, not reduced (floating only) [N] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_SIM !< UL for SIM = PhiL qL0- PhiM qm0, size nL [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_0m !< Intermediate UL term for SIM = PhiM qm0, size nL [-] - END TYPE SD_MiscVarType -! ======================= ! ========= SD_ParameterType ======= TYPE, PUBLIC :: SD_ParameterType + INTEGER(IntKi) :: iVarTPMesh = 0 !< Variable index for TPMesh [-] + INTEGER(IntKi) :: iVarLMesh = 0 !< Variable index for LMesh [-] + INTEGER(IntKi) :: iVarY1Mesh = 0 !< Variable index for Y1Mesh [-] + INTEGER(IntKi) :: iVarY2Mesh = 0 !< Variable index for Y2Mesh [-] + INTEGER(IntKi) :: iVarY3Mesh = 0 !< Variable index for Y3Mesh [-] + INTEGER(IntKi) :: iVarWriteOutput = 0 !< Variable index for WriteOutput [-] REAL(ReKi) :: g = 0.0_ReKi !< Gravity acceleration [m/s^2] REAL(DbKi) :: SDDeltaT = 0.0_R8Ki !< Time step (for integration of continuous states) [seconds] INTEGER(IntKi) :: IntMethod = 0_IntKi !< Integration Method (1/2/3)Length of y2 array [-] @@ -350,12 +323,6 @@ MODULE SubDyn_Types INTEGER(IntKi) :: OutAllInt = 0_IntKi !< Integer version of OutAll [-] INTEGER(IntKi) :: OutAllDims = 0_IntKi !< Integer version of OutAll [-] INTEGER(IntKi) :: OutDec = 0_IntKi !< Output Decimation for Requested Channels [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] - REAL(R8Ki) , DIMENSION(1:2) :: dx = 0.0_R8Ki !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] - INTEGER(IntKi) :: Jac_nx = 0_IntKi !< half the number of continuous states in jacobian matrix [-] - LOGICAL :: RotStates = .false. !< Orient states in rotating frame during linearization? (flag) [-] END TYPE SD_ParameterType ! ======================= ! ========= SD_InputType ======= @@ -373,7 +340,58 @@ MODULE SubDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file [-] END TYPE SD_OutputType ! ======================= -CONTAINS +! ========= SD_MiscVarType ======= + TYPE, PUBLIC :: SD_MiscVarType + TYPE(ModJacType) :: Jac !< Values corresponding to module variables [-] + TYPE(SD_ContinuousStateType) :: x_perturb !< [-] + TYPE(SD_ContinuousStateType) :: dxdt_lin !< [-] + TYPE(SD_InputType) :: u_perturb !< [-] + TYPE(SD_OutputType) :: y_lin !< [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: qmdotdot !< 2nd Derivative of states, used only for output-file purposes [-] + REAL(ReKi) , DIMENSION(1:6) :: u_TP = 0.0_ReKi + REAL(ReKi) , DIMENSION(1:6) :: udot_TP = 0.0_ReKi + REAL(ReKi) , DIMENSION(1:6) :: udotdot_TP = 0.0_ReKi + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_L !< Loads on internal DOF, size nL [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_L2 !< Loads on internal DOF, size nL, used for SIM and ADM4 [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar_dot + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar_dotdot + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL !< Internal DOFs (L) displacements [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_NS !< Internal DOFs (L) displacements, No SIM (NS) [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_dot + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_dotdot + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: DU_full !< Delta U used for extra moment, size nDOF [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: U_full !< Displacement of all DOFs (full system) with SIM [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: U_full_NS !< Displacement of all DOFs (full system), No SIM (NS) [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: U_full_dot + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: U_full_dotdot + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: U_full_elast !< Elastic displacements for computation of K ue (without rigid body mode for floating), includes SIM [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: U_red + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_full + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FC_unit !< Cable Force vector (for varying cable load, of unit cable load) [N] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SDWrOutput !< Data from previous step to be written to a SubDyn output file [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< Data for output file [-] + REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< The time of the most recent stored output data [s] + INTEGER(IntKi) :: Decimat = 0_IntKi !< Current output decimation counter [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Fext !< External loads on unconstrained DOFs [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Fext_red !< External loads on constrained DOFs, Fext_red= T^t Fext [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: FG !< Gravity force vector (without initial cable force T0) based on the instantaneous platform orientation, not reduced (floating only) [N] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_SIM !< UL for SIM = PhiL qL0- PhiM qm0, size nL [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_0m !< Intermediate UL term for SIM = PhiM qm0, size nL [-] + END TYPE SD_MiscVarType +! ======================= + integer(IntKi), public, parameter :: SD_x_qm = 1 ! SD%qm + integer(IntKi), public, parameter :: SD_x_qmdot = 2 ! SD%qmdot + integer(IntKi), public, parameter :: SD_z_DummyConstrState = 3 ! SD%DummyConstrState + integer(IntKi), public, parameter :: SD_u_TPMesh = 4 ! SD%TPMesh + integer(IntKi), public, parameter :: SD_u_LMesh = 5 ! SD%LMesh + integer(IntKi), public, parameter :: SD_u_CableDeltaL = 6 ! SD%CableDeltaL + integer(IntKi), public, parameter :: SD_y_Y1Mesh = 7 ! SD%Y1Mesh + integer(IntKi), public, parameter :: SD_y_Y2Mesh = 8 ! SD%Y2Mesh + integer(IntKi), public, parameter :: SD_y_Y3Mesh = 9 ! SD%Y3Mesh + integer(IntKi), public, parameter :: SD_y_WriteOutput = 10 ! SD%WriteOutput + +contains subroutine SD_CopyIList(SrcIListData, DstIListData, CtrlCode, ErrStat, ErrMsg) type(IList), intent(in) :: SrcIListData @@ -1009,6 +1027,9 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%LinNames_y)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_y) UB(1:1) = ubound(SrcInitOutputData%LinNames_y) @@ -1136,6 +1157,8 @@ subroutine SD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%LinNames_y)) then deallocate(InitOutputData%LinNames_y) end if @@ -1173,6 +1196,7 @@ subroutine SD_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) call NWTC_Library_PackProgDesc(RF, InData%Ver) + call NWTC_Library_PackModVarsType(RF, InData%Vars) call RegPackAlloc(RF, InData%LinNames_y) call RegPackAlloc(RF, InData%LinNames_x) call RegPackAlloc(RF, InData%LinNames_u) @@ -1196,6 +1220,7 @@ subroutine SD_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LinNames_x); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return @@ -2053,1436 +2078,934 @@ subroutine SD_UnPackOtherState(RF, OutData) call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(SD_MiscVarType), intent(in) :: SrcMiscData - type(SD_MiscVarType), intent(inout) :: DstMiscData +subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SD_ParameterType), intent(in) :: SrcParamData + type(SD_ParameterType), intent(inout) :: DstParamData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'SD_CopyMisc' + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_CopyParam' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcMiscData%qmdotdot)) then - LB(1:1) = lbound(SrcMiscData%qmdotdot) - UB(1:1) = ubound(SrcMiscData%qmdotdot) - if (.not. allocated(DstMiscData%qmdotdot)) then - allocate(DstMiscData%qmdotdot(LB(1):UB(1)), stat=ErrStat2) + DstParamData%iVarTPMesh = SrcParamData%iVarTPMesh + DstParamData%iVarLMesh = SrcParamData%iVarLMesh + DstParamData%iVarY1Mesh = SrcParamData%iVarY1Mesh + DstParamData%iVarY2Mesh = SrcParamData%iVarY2Mesh + DstParamData%iVarY3Mesh = SrcParamData%iVarY3Mesh + DstParamData%iVarWriteOutput = SrcParamData%iVarWriteOutput + DstParamData%g = SrcParamData%g + DstParamData%SDDeltaT = SrcParamData%SDDeltaT + DstParamData%IntMethod = SrcParamData%IntMethod + DstParamData%nDOF = SrcParamData%nDOF + DstParamData%nDOF_red = SrcParamData%nDOF_red + DstParamData%Nmembers = SrcParamData%Nmembers + if (allocated(SrcParamData%Elems)) then + LB(1:2) = lbound(SrcParamData%Elems) + UB(1:2) = ubound(SrcParamData%Elems) + if (.not. allocated(DstParamData%Elems)) then + allocate(DstParamData%Elems(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%qmdotdot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Elems.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%qmdotdot = SrcMiscData%qmdotdot + DstParamData%Elems = SrcParamData%Elems end if - DstMiscData%u_TP = SrcMiscData%u_TP - DstMiscData%udot_TP = SrcMiscData%udot_TP - DstMiscData%udotdot_TP = SrcMiscData%udotdot_TP - if (allocated(SrcMiscData%F_L)) then - LB(1:1) = lbound(SrcMiscData%F_L) - UB(1:1) = ubound(SrcMiscData%F_L) - if (.not. allocated(DstMiscData%F_L)) then - allocate(DstMiscData%F_L(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%ElemProps)) then + LB(1:1) = lbound(SrcParamData%ElemProps) + UB(1:1) = ubound(SrcParamData%ElemProps) + if (.not. allocated(DstParamData%ElemProps)) then + allocate(DstParamData%ElemProps(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElemProps.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%F_L = SrcMiscData%F_L + do i1 = LB(1), UB(1) + call SD_CopyElemPropType(SrcParamData%ElemProps(i1), DstParamData%ElemProps(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcMiscData%F_L2)) then - LB(1:1) = lbound(SrcMiscData%F_L2) - UB(1:1) = ubound(SrcMiscData%F_L2) - if (.not. allocated(DstMiscData%F_L2)) then - allocate(DstMiscData%F_L2(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%FC)) then + LB(1:1) = lbound(SrcParamData%FC) + UB(1:1) = ubound(SrcParamData%FC) + if (.not. allocated(DstParamData%FC)) then + allocate(DstParamData%FC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L2.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%F_L2 = SrcMiscData%F_L2 + DstParamData%FC = SrcParamData%FC end if - if (allocated(SrcMiscData%UR_bar)) then - LB(1:1) = lbound(SrcMiscData%UR_bar) - UB(1:1) = ubound(SrcMiscData%UR_bar) - if (.not. allocated(DstMiscData%UR_bar)) then - allocate(DstMiscData%UR_bar(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%FG)) then + LB(1:1) = lbound(SrcParamData%FG) + UB(1:1) = ubound(SrcParamData%FG) + if (.not. allocated(DstParamData%FG)) then + allocate(DstParamData%FG(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FG.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%UR_bar = SrcMiscData%UR_bar + DstParamData%FG = SrcParamData%FG end if - if (allocated(SrcMiscData%UR_bar_dot)) then - LB(1:1) = lbound(SrcMiscData%UR_bar_dot) - UB(1:1) = ubound(SrcMiscData%UR_bar_dot) - if (.not. allocated(DstMiscData%UR_bar_dot)) then - allocate(DstMiscData%UR_bar_dot(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%DP0)) then + LB(1:2) = lbound(SrcParamData%DP0) + UB(1:2) = ubound(SrcParamData%DP0) + if (.not. allocated(DstParamData%DP0)) then + allocate(DstParamData%DP0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DP0.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%UR_bar_dot = SrcMiscData%UR_bar_dot + DstParamData%DP0 = SrcParamData%DP0 end if - if (allocated(SrcMiscData%UR_bar_dotdot)) then - LB(1:1) = lbound(SrcMiscData%UR_bar_dotdot) - UB(1:1) = ubound(SrcMiscData%UR_bar_dotdot) - if (.not. allocated(DstMiscData%UR_bar_dotdot)) then - allocate(DstMiscData%UR_bar_dotdot(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%rPG)) then + LB(1:1) = lbound(SrcParamData%rPG) + UB(1:1) = ubound(SrcParamData%rPG) + if (.not. allocated(DstParamData%rPG)) then + allocate(DstParamData%rPG(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dotdot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rPG.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%UR_bar_dotdot = SrcMiscData%UR_bar_dotdot + DstParamData%rPG = SrcParamData%rPG end if - if (allocated(SrcMiscData%UL)) then - LB(1:1) = lbound(SrcMiscData%UL) - UB(1:1) = ubound(SrcMiscData%UL) - if (.not. allocated(DstMiscData%UL)) then - allocate(DstMiscData%UL(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%NodeID2JointID)) then + LB(1:1) = lbound(SrcParamData%NodeID2JointID) + UB(1:1) = ubound(SrcParamData%NodeID2JointID) + if (.not. allocated(DstParamData%NodeID2JointID)) then + allocate(DstParamData%NodeID2JointID(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodeID2JointID.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%UL = SrcMiscData%UL + DstParamData%NodeID2JointID = SrcParamData%NodeID2JointID end if - if (allocated(SrcMiscData%UL_NS)) then - LB(1:1) = lbound(SrcMiscData%UL_NS) - UB(1:1) = ubound(SrcMiscData%UL_NS) - if (.not. allocated(DstMiscData%UL_NS)) then - allocate(DstMiscData%UL_NS(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%CMassNode)) then + LB(1:1) = lbound(SrcParamData%CMassNode) + UB(1:1) = ubound(SrcParamData%CMassNode) + if (.not. allocated(DstParamData%CMassNode)) then + allocate(DstParamData%CMassNode(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_NS.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMassNode.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%UL_NS = SrcMiscData%UL_NS + DstParamData%CMassNode = SrcParamData%CMassNode end if - if (allocated(SrcMiscData%UL_dot)) then - LB(1:1) = lbound(SrcMiscData%UL_dot) - UB(1:1) = ubound(SrcMiscData%UL_dot) - if (.not. allocated(DstMiscData%UL_dot)) then - allocate(DstMiscData%UL_dot(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%CMassWeight)) then + LB(1:1) = lbound(SrcParamData%CMassWeight) + UB(1:1) = ubound(SrcParamData%CMassWeight) + if (.not. allocated(DstParamData%CMassWeight)) then + allocate(DstParamData%CMassWeight(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMassWeight.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%UL_dot = SrcMiscData%UL_dot + DstParamData%CMassWeight = SrcParamData%CMassWeight end if - if (allocated(SrcMiscData%UL_dotdot)) then - LB(1:1) = lbound(SrcMiscData%UL_dotdot) - UB(1:1) = ubound(SrcMiscData%UL_dotdot) - if (.not. allocated(DstMiscData%UL_dotdot)) then - allocate(DstMiscData%UL_dotdot(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%CMassOffset)) then + LB(1:2) = lbound(SrcParamData%CMassOffset) + UB(1:2) = ubound(SrcParamData%CMassOffset) + if (.not. allocated(DstParamData%CMassOffset)) then + allocate(DstParamData%CMassOffset(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dotdot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMassOffset.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%UL_dotdot = SrcMiscData%UL_dotdot + DstParamData%CMassOffset = SrcParamData%CMassOffset end if - if (allocated(SrcMiscData%DU_full)) then - LB(1:1) = lbound(SrcMiscData%DU_full) - UB(1:1) = ubound(SrcMiscData%DU_full) - if (.not. allocated(DstMiscData%DU_full)) then - allocate(DstMiscData%DU_full(LB(1):UB(1)), stat=ErrStat2) + DstParamData%reduced = SrcParamData%reduced + if (allocated(SrcParamData%T_red)) then + LB(1:2) = lbound(SrcParamData%T_red) + UB(1:2) = ubound(SrcParamData%T_red) + if (.not. allocated(DstParamData%T_red)) then + allocate(DstParamData%T_red(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DU_full.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%T_red.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%DU_full = SrcMiscData%DU_full + DstParamData%T_red = SrcParamData%T_red end if - if (allocated(SrcMiscData%U_full)) then - LB(1:1) = lbound(SrcMiscData%U_full) - UB(1:1) = ubound(SrcMiscData%U_full) - if (.not. allocated(DstMiscData%U_full)) then - allocate(DstMiscData%U_full(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%T_red_T)) then + LB(1:2) = lbound(SrcParamData%T_red_T) + UB(1:2) = ubound(SrcParamData%T_red_T) + if (.not. allocated(DstParamData%T_red_T)) then + allocate(DstParamData%T_red_T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%T_red_T.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%U_full = SrcMiscData%U_full + DstParamData%T_red_T = SrcParamData%T_red_T end if - if (allocated(SrcMiscData%U_full_NS)) then - LB(1:1) = lbound(SrcMiscData%U_full_NS) - UB(1:1) = ubound(SrcMiscData%U_full_NS) - if (.not. allocated(DstMiscData%U_full_NS)) then - allocate(DstMiscData%U_full_NS(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%NodesDOF)) then + LB(1:1) = lbound(SrcParamData%NodesDOF) + UB(1:1) = ubound(SrcParamData%NodesDOF) + if (.not. allocated(DstParamData%NodesDOF)) then + allocate(DstParamData%NodesDOF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_NS.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOF.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%U_full_NS = SrcMiscData%U_full_NS + do i1 = LB(1), UB(1) + call SD_CopyIList(SrcParamData%NodesDOF(i1), DstParamData%NodesDOF(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcMiscData%U_full_dot)) then - LB(1:1) = lbound(SrcMiscData%U_full_dot) - UB(1:1) = ubound(SrcMiscData%U_full_dot) - if (.not. allocated(DstMiscData%U_full_dot)) then - allocate(DstMiscData%U_full_dot(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%NodesDOFred)) then + LB(1:1) = lbound(SrcParamData%NodesDOFred) + UB(1:1) = ubound(SrcParamData%NodesDOFred) + if (.not. allocated(DstParamData%NodesDOFred)) then + allocate(DstParamData%NodesDOFred(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOFred.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%U_full_dot = SrcMiscData%U_full_dot + do i1 = LB(1), UB(1) + call SD_CopyIList(SrcParamData%NodesDOFred(i1), DstParamData%NodesDOFred(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcMiscData%U_full_dotdot)) then - LB(1:1) = lbound(SrcMiscData%U_full_dotdot) - UB(1:1) = ubound(SrcMiscData%U_full_dotdot) - if (.not. allocated(DstMiscData%U_full_dotdot)) then - allocate(DstMiscData%U_full_dotdot(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%ElemsDOF)) then + LB(1:2) = lbound(SrcParamData%ElemsDOF) + UB(1:2) = ubound(SrcParamData%ElemsDOF) + if (.not. allocated(DstParamData%ElemsDOF)) then + allocate(DstParamData%ElemsDOF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dotdot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElemsDOF.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%U_full_dotdot = SrcMiscData%U_full_dotdot + DstParamData%ElemsDOF = SrcParamData%ElemsDOF end if - if (allocated(SrcMiscData%U_full_elast)) then - LB(1:1) = lbound(SrcMiscData%U_full_elast) - UB(1:1) = ubound(SrcMiscData%U_full_elast) - if (.not. allocated(DstMiscData%U_full_elast)) then - allocate(DstMiscData%U_full_elast(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%DOFred2Nodes)) then + LB(1:2) = lbound(SrcParamData%DOFred2Nodes) + UB(1:2) = ubound(SrcParamData%DOFred2Nodes) + if (.not. allocated(DstParamData%DOFred2Nodes)) then + allocate(DstParamData%DOFred2Nodes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_elast.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOFred2Nodes.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%U_full_elast = SrcMiscData%U_full_elast + DstParamData%DOFred2Nodes = SrcParamData%DOFred2Nodes end if - if (allocated(SrcMiscData%U_red)) then - LB(1:1) = lbound(SrcMiscData%U_red) - UB(1:1) = ubound(SrcMiscData%U_red) - if (.not. allocated(DstMiscData%U_red)) then - allocate(DstMiscData%U_red(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%CtrlElem2Channel)) then + LB(1:2) = lbound(SrcParamData%CtrlElem2Channel) + UB(1:2) = ubound(SrcParamData%CtrlElem2Channel) + if (.not. allocated(DstParamData%CtrlElem2Channel)) then + allocate(DstParamData%CtrlElem2Channel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_red.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CtrlElem2Channel.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%U_red = SrcMiscData%U_red + DstParamData%CtrlElem2Channel = SrcParamData%CtrlElem2Channel end if - if (allocated(SrcMiscData%FC_unit)) then - LB(1:1) = lbound(SrcMiscData%FC_unit) - UB(1:1) = ubound(SrcMiscData%FC_unit) - if (.not. allocated(DstMiscData%FC_unit)) then - allocate(DstMiscData%FC_unit(LB(1):UB(1)), stat=ErrStat2) + DstParamData%nDOFM = SrcParamData%nDOFM + DstParamData%SttcSolve = SrcParamData%SttcSolve + DstParamData%GuyanLoadCorrection = SrcParamData%GuyanLoadCorrection + DstParamData%Floating = SrcParamData%Floating + if (allocated(SrcParamData%KMMDiag)) then + LB(1:1) = lbound(SrcParamData%KMMDiag) + UB(1:1) = ubound(SrcParamData%KMMDiag) + if (.not. allocated(DstParamData%KMMDiag)) then + allocate(DstParamData%KMMDiag(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FC_unit.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KMMDiag.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%FC_unit = SrcMiscData%FC_unit + DstParamData%KMMDiag = SrcParamData%KMMDiag end if - if (allocated(SrcMiscData%SDWrOutput)) then - LB(1:1) = lbound(SrcMiscData%SDWrOutput) - UB(1:1) = ubound(SrcMiscData%SDWrOutput) - if (.not. allocated(DstMiscData%SDWrOutput)) then - allocate(DstMiscData%SDWrOutput(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%CMMDiag)) then + LB(1:1) = lbound(SrcParamData%CMMDiag) + UB(1:1) = ubound(SrcParamData%CMMDiag) + if (.not. allocated(DstParamData%CMMDiag)) then + allocate(DstParamData%CMMDiag(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SDWrOutput.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMMDiag.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%SDWrOutput = SrcMiscData%SDWrOutput + DstParamData%CMMDiag = SrcParamData%CMMDiag end if - if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts) - UB(1:1) = ubound(SrcMiscData%AllOuts) - if (.not. allocated(DstMiscData%AllOuts)) then - allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%MMB)) then + LB(1:2) = lbound(SrcParamData%MMB) + UB(1:2) = ubound(SrcParamData%MMB) + if (.not. allocated(DstParamData%MMB)) then + allocate(DstParamData%MMB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MMB.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%AllOuts = SrcMiscData%AllOuts + DstParamData%MMB = SrcParamData%MMB end if - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - DstMiscData%Decimat = SrcMiscData%Decimat - if (allocated(SrcMiscData%Fext)) then - LB(1:1) = lbound(SrcMiscData%Fext) - UB(1:1) = ubound(SrcMiscData%Fext) - if (.not. allocated(DstMiscData%Fext)) then - allocate(DstMiscData%Fext(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%MBmmB)) then + LB(1:2) = lbound(SrcParamData%MBmmB) + UB(1:2) = ubound(SrcParamData%MBmmB) + if (.not. allocated(DstParamData%MBmmB)) then + allocate(DstParamData%MBmmB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBmmB.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%Fext = SrcMiscData%Fext + DstParamData%MBmmB = SrcParamData%MBmmB end if - if (allocated(SrcMiscData%Fext_red)) then - LB(1:1) = lbound(SrcMiscData%Fext_red) - UB(1:1) = ubound(SrcMiscData%Fext_red) - if (.not. allocated(DstMiscData%Fext_red)) then - allocate(DstMiscData%Fext_red(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%C1_11)) then + LB(1:2) = lbound(SrcParamData%C1_11) + UB(1:2) = ubound(SrcParamData%C1_11) + if (.not. allocated(DstParamData%C1_11)) then + allocate(DstParamData%C1_11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext_red.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C1_11.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%Fext_red = SrcMiscData%Fext_red + DstParamData%C1_11 = SrcParamData%C1_11 end if - if (allocated(SrcMiscData%FG)) then - LB(1:1) = lbound(SrcMiscData%FG) - UB(1:1) = ubound(SrcMiscData%FG) - if (.not. allocated(DstMiscData%FG)) then - allocate(DstMiscData%FG(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%C1_12)) then + LB(1:2) = lbound(SrcParamData%C1_12) + UB(1:2) = ubound(SrcParamData%C1_12) + if (.not. allocated(DstParamData%C1_12)) then + allocate(DstParamData%C1_12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FG.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C1_12.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%FG = SrcMiscData%FG + DstParamData%C1_12 = SrcParamData%C1_12 end if - if (allocated(SrcMiscData%UL_SIM)) then - LB(1:1) = lbound(SrcMiscData%UL_SIM) - UB(1:1) = ubound(SrcMiscData%UL_SIM) - if (.not. allocated(DstMiscData%UL_SIM)) then - allocate(DstMiscData%UL_SIM(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%D1_141)) then + LB(1:2) = lbound(SrcParamData%D1_141) + UB(1:2) = ubound(SrcParamData%D1_141) + if (.not. allocated(DstParamData%D1_141)) then + allocate(DstParamData%D1_141(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_SIM.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_141.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%UL_SIM = SrcMiscData%UL_SIM + DstParamData%D1_141 = SrcParamData%D1_141 end if - if (allocated(SrcMiscData%UL_0m)) then - LB(1:1) = lbound(SrcMiscData%UL_0m) - UB(1:1) = ubound(SrcMiscData%UL_0m) - if (.not. allocated(DstMiscData%UL_0m)) then - allocate(DstMiscData%UL_0m(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%D1_142)) then + LB(1:2) = lbound(SrcParamData%D1_142) + UB(1:2) = ubound(SrcParamData%D1_142) + if (.not. allocated(DstParamData%D1_142)) then + allocate(DstParamData%D1_142(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_0m.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_142.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%UL_0m = SrcMiscData%UL_0m - end if -end subroutine - -subroutine SD_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(SD_MiscVarType), intent(inout) :: MiscData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SD_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(MiscData%qmdotdot)) then - deallocate(MiscData%qmdotdot) + DstParamData%D1_142 = SrcParamData%D1_142 end if - if (allocated(MiscData%F_L)) then - deallocate(MiscData%F_L) + if (allocated(SrcParamData%PhiM)) then + LB(1:2) = lbound(SrcParamData%PhiM) + UB(1:2) = ubound(SrcParamData%PhiM) + if (.not. allocated(DstParamData%PhiM)) then + allocate(DstParamData%PhiM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PhiM = SrcParamData%PhiM end if - if (allocated(MiscData%F_L2)) then - deallocate(MiscData%F_L2) + if (allocated(SrcParamData%C2_61)) then + LB(1:2) = lbound(SrcParamData%C2_61) + UB(1:2) = ubound(SrcParamData%C2_61) + if (.not. allocated(DstParamData%C2_61)) then + allocate(DstParamData%C2_61(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C2_61.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C2_61 = SrcParamData%C2_61 end if - if (allocated(MiscData%UR_bar)) then - deallocate(MiscData%UR_bar) + if (allocated(SrcParamData%C2_62)) then + LB(1:2) = lbound(SrcParamData%C2_62) + UB(1:2) = ubound(SrcParamData%C2_62) + if (.not. allocated(DstParamData%C2_62)) then + allocate(DstParamData%C2_62(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C2_62.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C2_62 = SrcParamData%C2_62 end if - if (allocated(MiscData%UR_bar_dot)) then - deallocate(MiscData%UR_bar_dot) + if (allocated(SrcParamData%PhiRb_TI)) then + LB(1:2) = lbound(SrcParamData%PhiRb_TI) + UB(1:2) = ubound(SrcParamData%PhiRb_TI) + if (.not. allocated(DstParamData%PhiRb_TI)) then + allocate(DstParamData%PhiRb_TI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiRb_TI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PhiRb_TI = SrcParamData%PhiRb_TI end if - if (allocated(MiscData%UR_bar_dotdot)) then - deallocate(MiscData%UR_bar_dotdot) - end if - if (allocated(MiscData%UL)) then - deallocate(MiscData%UL) - end if - if (allocated(MiscData%UL_NS)) then - deallocate(MiscData%UL_NS) - end if - if (allocated(MiscData%UL_dot)) then - deallocate(MiscData%UL_dot) - end if - if (allocated(MiscData%UL_dotdot)) then - deallocate(MiscData%UL_dotdot) - end if - if (allocated(MiscData%DU_full)) then - deallocate(MiscData%DU_full) - end if - if (allocated(MiscData%U_full)) then - deallocate(MiscData%U_full) - end if - if (allocated(MiscData%U_full_NS)) then - deallocate(MiscData%U_full_NS) - end if - if (allocated(MiscData%U_full_dot)) then - deallocate(MiscData%U_full_dot) - end if - if (allocated(MiscData%U_full_dotdot)) then - deallocate(MiscData%U_full_dotdot) - end if - if (allocated(MiscData%U_full_elast)) then - deallocate(MiscData%U_full_elast) - end if - if (allocated(MiscData%U_red)) then - deallocate(MiscData%U_red) - end if - if (allocated(MiscData%FC_unit)) then - deallocate(MiscData%FC_unit) - end if - if (allocated(MiscData%SDWrOutput)) then - deallocate(MiscData%SDWrOutput) - end if - if (allocated(MiscData%AllOuts)) then - deallocate(MiscData%AllOuts) - end if - if (allocated(MiscData%Fext)) then - deallocate(MiscData%Fext) - end if - if (allocated(MiscData%Fext_red)) then - deallocate(MiscData%Fext_red) - end if - if (allocated(MiscData%FG)) then - deallocate(MiscData%FG) - end if - if (allocated(MiscData%UL_SIM)) then - deallocate(MiscData%UL_SIM) - end if - if (allocated(MiscData%UL_0m)) then - deallocate(MiscData%UL_0m) - end if -end subroutine - -subroutine SD_PackMisc(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SD_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SD_PackMisc' - if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%qmdotdot) - call RegPack(RF, InData%u_TP) - call RegPack(RF, InData%udot_TP) - call RegPack(RF, InData%udotdot_TP) - call RegPackAlloc(RF, InData%F_L) - call RegPackAlloc(RF, InData%F_L2) - call RegPackAlloc(RF, InData%UR_bar) - call RegPackAlloc(RF, InData%UR_bar_dot) - call RegPackAlloc(RF, InData%UR_bar_dotdot) - call RegPackAlloc(RF, InData%UL) - call RegPackAlloc(RF, InData%UL_NS) - call RegPackAlloc(RF, InData%UL_dot) - call RegPackAlloc(RF, InData%UL_dotdot) - call RegPackAlloc(RF, InData%DU_full) - call RegPackAlloc(RF, InData%U_full) - call RegPackAlloc(RF, InData%U_full_NS) - call RegPackAlloc(RF, InData%U_full_dot) - call RegPackAlloc(RF, InData%U_full_dotdot) - call RegPackAlloc(RF, InData%U_full_elast) - call RegPackAlloc(RF, InData%U_red) - call RegPackAlloc(RF, InData%FC_unit) - call RegPackAlloc(RF, InData%SDWrOutput) - call RegPackAlloc(RF, InData%AllOuts) - call RegPack(RF, InData%LastOutTime) - call RegPack(RF, InData%Decimat) - call RegPackAlloc(RF, InData%Fext) - call RegPackAlloc(RF, InData%Fext_red) - call RegPackAlloc(RF, InData%FG) - call RegPackAlloc(RF, InData%UL_SIM) - call RegPackAlloc(RF, InData%UL_0m) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SD_UnPackMisc(RF, OutData) - type(RegFile), intent(inout) :: RF - type(SD_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SD_UnPackMisc' - integer(B4Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%qmdotdot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%u_TP); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%udot_TP); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%udotdot_TP); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%F_L); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%F_L2); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UR_bar); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UR_bar_dot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UR_bar_dotdot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UL_NS); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UL_dot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UL_dotdot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%DU_full); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%U_full); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%U_full_NS); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%U_full_dot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%U_full_dotdot); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%U_full_elast); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%U_red); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%FC_unit); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%SDWrOutput); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Decimat); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Fext); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Fext_red); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%FG); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UL_SIM); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%UL_0m); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) - type(SD_ParameterType), intent(in) :: SrcParamData - type(SD_ParameterType), intent(inout) :: DstParamData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SD_CopyParam' - ErrStat = ErrID_None - ErrMsg = '' - DstParamData%g = SrcParamData%g - DstParamData%SDDeltaT = SrcParamData%SDDeltaT - DstParamData%IntMethod = SrcParamData%IntMethod - DstParamData%nDOF = SrcParamData%nDOF - DstParamData%nDOF_red = SrcParamData%nDOF_red - DstParamData%Nmembers = SrcParamData%Nmembers - if (allocated(SrcParamData%Elems)) then - LB(1:2) = lbound(SrcParamData%Elems) - UB(1:2) = ubound(SrcParamData%Elems) - if (.not. allocated(DstParamData%Elems)) then - allocate(DstParamData%Elems(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%D2_63)) then + LB(1:2) = lbound(SrcParamData%D2_63) + UB(1:2) = ubound(SrcParamData%D2_63) + if (.not. allocated(DstParamData%D2_63)) then + allocate(DstParamData%D2_63(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Elems.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_63.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%Elems = SrcParamData%Elems + DstParamData%D2_63 = SrcParamData%D2_63 end if - if (allocated(SrcParamData%ElemProps)) then - LB(1:1) = lbound(SrcParamData%ElemProps) - UB(1:1) = ubound(SrcParamData%ElemProps) - if (.not. allocated(DstParamData%ElemProps)) then - allocate(DstParamData%ElemProps(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%D2_64)) then + LB(1:2) = lbound(SrcParamData%D2_64) + UB(1:2) = ubound(SrcParamData%D2_64) + if (.not. allocated(DstParamData%D2_64)) then + allocate(DstParamData%D2_64(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElemProps.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_64.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call SD_CopyElemPropType(SrcParamData%ElemProps(i1), DstParamData%ElemProps(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%D2_64 = SrcParamData%D2_64 end if - if (allocated(SrcParamData%FC)) then - LB(1:1) = lbound(SrcParamData%FC) - UB(1:1) = ubound(SrcParamData%FC) - if (.not. allocated(DstParamData%FC)) then - allocate(DstParamData%FC(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%MBB)) then + LB(1:2) = lbound(SrcParamData%MBB) + UB(1:2) = ubound(SrcParamData%MBB) + if (.not. allocated(DstParamData%MBB)) then + allocate(DstParamData%MBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBB.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%FC = SrcParamData%FC + DstParamData%MBB = SrcParamData%MBB end if - if (allocated(SrcParamData%FG)) then - LB(1:1) = lbound(SrcParamData%FG) - UB(1:1) = ubound(SrcParamData%FG) - if (.not. allocated(DstParamData%FG)) then - allocate(DstParamData%FG(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%KBB)) then + LB(1:2) = lbound(SrcParamData%KBB) + UB(1:2) = ubound(SrcParamData%KBB) + if (.not. allocated(DstParamData%KBB)) then + allocate(DstParamData%KBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FG.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBB.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%FG = SrcParamData%FG + DstParamData%KBB = SrcParamData%KBB end if - if (allocated(SrcParamData%DP0)) then - LB(1:2) = lbound(SrcParamData%DP0) - UB(1:2) = ubound(SrcParamData%DP0) - if (.not. allocated(DstParamData%DP0)) then - allocate(DstParamData%DP0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%CBB)) then + LB(1:2) = lbound(SrcParamData%CBB) + UB(1:2) = ubound(SrcParamData%CBB) + if (.not. allocated(DstParamData%CBB)) then + allocate(DstParamData%CBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DP0.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBB.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%DP0 = SrcParamData%DP0 + DstParamData%CBB = SrcParamData%CBB end if - if (allocated(SrcParamData%rPG)) then - LB(1:1) = lbound(SrcParamData%rPG) - UB(1:1) = ubound(SrcParamData%rPG) - if (.not. allocated(DstParamData%rPG)) then - allocate(DstParamData%rPG(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%CMM)) then + LB(1:2) = lbound(SrcParamData%CMM) + UB(1:2) = ubound(SrcParamData%CMM) + if (.not. allocated(DstParamData%CMM)) then + allocate(DstParamData%CMM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rPG.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMM.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%rPG = SrcParamData%rPG + DstParamData%CMM = SrcParamData%CMM end if - if (allocated(SrcParamData%NodeID2JointID)) then - LB(1:1) = lbound(SrcParamData%NodeID2JointID) - UB(1:1) = ubound(SrcParamData%NodeID2JointID) - if (.not. allocated(DstParamData%NodeID2JointID)) then - allocate(DstParamData%NodeID2JointID(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%MBM)) then + LB(1:2) = lbound(SrcParamData%MBM) + UB(1:2) = ubound(SrcParamData%MBM) + if (.not. allocated(DstParamData%MBM)) then + allocate(DstParamData%MBM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodeID2JointID.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBM.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%NodeID2JointID = SrcParamData%NodeID2JointID + DstParamData%MBM = SrcParamData%MBM end if - if (allocated(SrcParamData%CMassNode)) then - LB(1:1) = lbound(SrcParamData%CMassNode) - UB(1:1) = ubound(SrcParamData%CMassNode) - if (.not. allocated(DstParamData%CMassNode)) then - allocate(DstParamData%CMassNode(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%PhiL_T)) then + LB(1:2) = lbound(SrcParamData%PhiL_T) + UB(1:2) = ubound(SrcParamData%PhiL_T) + if (.not. allocated(DstParamData%PhiL_T)) then + allocate(DstParamData%PhiL_T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMassNode.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiL_T.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%CMassNode = SrcParamData%CMassNode + DstParamData%PhiL_T = SrcParamData%PhiL_T end if - if (allocated(SrcParamData%CMassWeight)) then - LB(1:1) = lbound(SrcParamData%CMassWeight) - UB(1:1) = ubound(SrcParamData%CMassWeight) - if (.not. allocated(DstParamData%CMassWeight)) then - allocate(DstParamData%CMassWeight(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%PhiLInvOmgL2)) then + LB(1:2) = lbound(SrcParamData%PhiLInvOmgL2) + UB(1:2) = ubound(SrcParamData%PhiLInvOmgL2) + if (.not. allocated(DstParamData%PhiLInvOmgL2)) then + allocate(DstParamData%PhiLInvOmgL2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMassWeight.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiLInvOmgL2.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%CMassWeight = SrcParamData%CMassWeight + DstParamData%PhiLInvOmgL2 = SrcParamData%PhiLInvOmgL2 end if - if (allocated(SrcParamData%CMassOffset)) then - LB(1:2) = lbound(SrcParamData%CMassOffset) - UB(1:2) = ubound(SrcParamData%CMassOffset) - if (.not. allocated(DstParamData%CMassOffset)) then - allocate(DstParamData%CMassOffset(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%KLLm1)) then + LB(1:2) = lbound(SrcParamData%KLLm1) + UB(1:2) = ubound(SrcParamData%KLLm1) + if (.not. allocated(DstParamData%KLLm1)) then + allocate(DstParamData%KLLm1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMassOffset.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KLLm1.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%CMassOffset = SrcParamData%CMassOffset + DstParamData%KLLm1 = SrcParamData%KLLm1 end if - DstParamData%reduced = SrcParamData%reduced - if (allocated(SrcParamData%T_red)) then - LB(1:2) = lbound(SrcParamData%T_red) - UB(1:2) = ubound(SrcParamData%T_red) - if (.not. allocated(DstParamData%T_red)) then - allocate(DstParamData%T_red(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%AM2Jac)) then + LB(1:2) = lbound(SrcParamData%AM2Jac) + UB(1:2) = ubound(SrcParamData%AM2Jac) + if (.not. allocated(DstParamData%AM2Jac)) then + allocate(DstParamData%AM2Jac(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%T_red.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2Jac.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%T_red = SrcParamData%T_red + DstParamData%AM2Jac = SrcParamData%AM2Jac end if - if (allocated(SrcParamData%T_red_T)) then - LB(1:2) = lbound(SrcParamData%T_red_T) - UB(1:2) = ubound(SrcParamData%T_red_T) - if (.not. allocated(DstParamData%T_red_T)) then - allocate(DstParamData%T_red_T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%AM2JacPiv)) then + LB(1:1) = lbound(SrcParamData%AM2JacPiv) + UB(1:1) = ubound(SrcParamData%AM2JacPiv) + if (.not. allocated(DstParamData%AM2JacPiv)) then + allocate(DstParamData%AM2JacPiv(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%T_red_T.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2JacPiv.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%T_red_T = SrcParamData%T_red_T + DstParamData%AM2JacPiv = SrcParamData%AM2JacPiv end if - if (allocated(SrcParamData%NodesDOF)) then - LB(1:1) = lbound(SrcParamData%NodesDOF) - UB(1:1) = ubound(SrcParamData%NodesDOF) - if (.not. allocated(DstParamData%NodesDOF)) then - allocate(DstParamData%NodesDOF(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%TI)) then + LB(1:2) = lbound(SrcParamData%TI) + UB(1:2) = ubound(SrcParamData%TI) + if (.not. allocated(DstParamData%TI)) then + allocate(DstParamData%TI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOF.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TI.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call SD_CopyIList(SrcParamData%NodesDOF(i1), DstParamData%NodesDOF(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%TI = SrcParamData%TI end if - if (allocated(SrcParamData%NodesDOFred)) then - LB(1:1) = lbound(SrcParamData%NodesDOFred) - UB(1:1) = ubound(SrcParamData%NodesDOFred) - if (.not. allocated(DstParamData%NodesDOFred)) then - allocate(DstParamData%NodesDOFred(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%TIreact)) then + LB(1:2) = lbound(SrcParamData%TIreact) + UB(1:2) = ubound(SrcParamData%TIreact) + if (.not. allocated(DstParamData%TIreact)) then + allocate(DstParamData%TIreact(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOFred.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TIreact.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call SD_CopyIList(SrcParamData%NodesDOFred(i1), DstParamData%NodesDOFred(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%TIreact = SrcParamData%TIreact end if - if (allocated(SrcParamData%ElemsDOF)) then - LB(1:2) = lbound(SrcParamData%ElemsDOF) - UB(1:2) = ubound(SrcParamData%ElemsDOF) - if (.not. allocated(DstParamData%ElemsDOF)) then - allocate(DstParamData%ElemsDOF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + DstParamData%nNodes = SrcParamData%nNodes + DstParamData%nNodes_I = SrcParamData%nNodes_I + DstParamData%nNodes_L = SrcParamData%nNodes_L + DstParamData%nNodes_C = SrcParamData%nNodes_C + if (allocated(SrcParamData%Nodes_I)) then + LB(1:2) = lbound(SrcParamData%Nodes_I) + UB(1:2) = ubound(SrcParamData%Nodes_I) + if (.not. allocated(DstParamData%Nodes_I)) then + allocate(DstParamData%Nodes_I(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElemsDOF.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_I.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%ElemsDOF = SrcParamData%ElemsDOF + DstParamData%Nodes_I = SrcParamData%Nodes_I end if - if (allocated(SrcParamData%DOFred2Nodes)) then - LB(1:2) = lbound(SrcParamData%DOFred2Nodes) - UB(1:2) = ubound(SrcParamData%DOFred2Nodes) - if (.not. allocated(DstParamData%DOFred2Nodes)) then - allocate(DstParamData%DOFred2Nodes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%Nodes_L)) then + LB(1:2) = lbound(SrcParamData%Nodes_L) + UB(1:2) = ubound(SrcParamData%Nodes_L) + if (.not. allocated(DstParamData%Nodes_L)) then + allocate(DstParamData%Nodes_L(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOFred2Nodes.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_L.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%DOFred2Nodes = SrcParamData%DOFred2Nodes + DstParamData%Nodes_L = SrcParamData%Nodes_L end if - if (allocated(SrcParamData%CtrlElem2Channel)) then - LB(1:2) = lbound(SrcParamData%CtrlElem2Channel) - UB(1:2) = ubound(SrcParamData%CtrlElem2Channel) - if (.not. allocated(DstParamData%CtrlElem2Channel)) then - allocate(DstParamData%CtrlElem2Channel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%Nodes_C)) then + LB(1:2) = lbound(SrcParamData%Nodes_C) + UB(1:2) = ubound(SrcParamData%Nodes_C) + if (.not. allocated(DstParamData%Nodes_C)) then + allocate(DstParamData%Nodes_C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CtrlElem2Channel.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_C.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%CtrlElem2Channel = SrcParamData%CtrlElem2Channel + DstParamData%Nodes_C = SrcParamData%Nodes_C end if - DstParamData%nDOFM = SrcParamData%nDOFM - DstParamData%SttcSolve = SrcParamData%SttcSolve - DstParamData%GuyanLoadCorrection = SrcParamData%GuyanLoadCorrection - DstParamData%Floating = SrcParamData%Floating - if (allocated(SrcParamData%KMMDiag)) then - LB(1:1) = lbound(SrcParamData%KMMDiag) - UB(1:1) = ubound(SrcParamData%KMMDiag) - if (.not. allocated(DstParamData%KMMDiag)) then - allocate(DstParamData%KMMDiag(LB(1):UB(1)), stat=ErrStat2) + DstParamData%nDOFI__ = SrcParamData%nDOFI__ + DstParamData%nDOFI_Rb = SrcParamData%nDOFI_Rb + DstParamData%nDOFI_F = SrcParamData%nDOFI_F + DstParamData%nDOFL_L = SrcParamData%nDOFL_L + DstParamData%nDOFC__ = SrcParamData%nDOFC__ + DstParamData%nDOFC_Rb = SrcParamData%nDOFC_Rb + DstParamData%nDOFC_L = SrcParamData%nDOFC_L + DstParamData%nDOFC_F = SrcParamData%nDOFC_F + DstParamData%nDOFR__ = SrcParamData%nDOFR__ + DstParamData%nDOF__Rb = SrcParamData%nDOF__Rb + DstParamData%nDOF__L = SrcParamData%nDOF__L + DstParamData%nDOF__F = SrcParamData%nDOF__F + if (allocated(SrcParamData%IDI__)) then + LB(1:1) = lbound(SrcParamData%IDI__) + UB(1:1) = ubound(SrcParamData%IDI__) + if (.not. allocated(DstParamData%IDI__)) then + allocate(DstParamData%IDI__(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KMMDiag.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI__.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%KMMDiag = SrcParamData%KMMDiag + DstParamData%IDI__ = SrcParamData%IDI__ end if - if (allocated(SrcParamData%CMMDiag)) then - LB(1:1) = lbound(SrcParamData%CMMDiag) - UB(1:1) = ubound(SrcParamData%CMMDiag) - if (.not. allocated(DstParamData%CMMDiag)) then - allocate(DstParamData%CMMDiag(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%IDI_Rb)) then + LB(1:1) = lbound(SrcParamData%IDI_Rb) + UB(1:1) = ubound(SrcParamData%IDI_Rb) + if (.not. allocated(DstParamData%IDI_Rb)) then + allocate(DstParamData%IDI_Rb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMMDiag.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_Rb.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%CMMDiag = SrcParamData%CMMDiag + DstParamData%IDI_Rb = SrcParamData%IDI_Rb end if - if (allocated(SrcParamData%MMB)) then - LB(1:2) = lbound(SrcParamData%MMB) - UB(1:2) = ubound(SrcParamData%MMB) - if (.not. allocated(DstParamData%MMB)) then - allocate(DstParamData%MMB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%IDI_F)) then + LB(1:1) = lbound(SrcParamData%IDI_F) + UB(1:1) = ubound(SrcParamData%IDI_F) + if (.not. allocated(DstParamData%IDI_F)) then + allocate(DstParamData%IDI_F(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MMB.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_F.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%MMB = SrcParamData%MMB + DstParamData%IDI_F = SrcParamData%IDI_F end if - if (allocated(SrcParamData%MBmmB)) then - LB(1:2) = lbound(SrcParamData%MBmmB) - UB(1:2) = ubound(SrcParamData%MBmmB) - if (.not. allocated(DstParamData%MBmmB)) then - allocate(DstParamData%MBmmB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%IDL_L)) then + LB(1:1) = lbound(SrcParamData%IDL_L) + UB(1:1) = ubound(SrcParamData%IDL_L) + if (.not. allocated(DstParamData%IDL_L)) then + allocate(DstParamData%IDL_L(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBmmB.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDL_L.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%MBmmB = SrcParamData%MBmmB + DstParamData%IDL_L = SrcParamData%IDL_L end if - if (allocated(SrcParamData%C1_11)) then - LB(1:2) = lbound(SrcParamData%C1_11) - UB(1:2) = ubound(SrcParamData%C1_11) - if (.not. allocated(DstParamData%C1_11)) then - allocate(DstParamData%C1_11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%IDC__)) then + LB(1:1) = lbound(SrcParamData%IDC__) + UB(1:1) = ubound(SrcParamData%IDC__) + if (.not. allocated(DstParamData%IDC__)) then + allocate(DstParamData%IDC__(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C1_11.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC__.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%C1_11 = SrcParamData%C1_11 + DstParamData%IDC__ = SrcParamData%IDC__ end if - if (allocated(SrcParamData%C1_12)) then - LB(1:2) = lbound(SrcParamData%C1_12) - UB(1:2) = ubound(SrcParamData%C1_12) - if (.not. allocated(DstParamData%C1_12)) then - allocate(DstParamData%C1_12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%IDC_Rb)) then + LB(1:1) = lbound(SrcParamData%IDC_Rb) + UB(1:1) = ubound(SrcParamData%IDC_Rb) + if (.not. allocated(DstParamData%IDC_Rb)) then + allocate(DstParamData%IDC_Rb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C1_12.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_Rb.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%C1_12 = SrcParamData%C1_12 + DstParamData%IDC_Rb = SrcParamData%IDC_Rb end if - if (allocated(SrcParamData%D1_141)) then - LB(1:2) = lbound(SrcParamData%D1_141) - UB(1:2) = ubound(SrcParamData%D1_141) - if (.not. allocated(DstParamData%D1_141)) then - allocate(DstParamData%D1_141(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%IDC_L)) then + LB(1:1) = lbound(SrcParamData%IDC_L) + UB(1:1) = ubound(SrcParamData%IDC_L) + if (.not. allocated(DstParamData%IDC_L)) then + allocate(DstParamData%IDC_L(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_141.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_L.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%D1_141 = SrcParamData%D1_141 + DstParamData%IDC_L = SrcParamData%IDC_L end if - if (allocated(SrcParamData%D1_142)) then - LB(1:2) = lbound(SrcParamData%D1_142) - UB(1:2) = ubound(SrcParamData%D1_142) - if (.not. allocated(DstParamData%D1_142)) then - allocate(DstParamData%D1_142(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%IDC_F)) then + LB(1:1) = lbound(SrcParamData%IDC_F) + UB(1:1) = ubound(SrcParamData%IDC_F) + if (.not. allocated(DstParamData%IDC_F)) then + allocate(DstParamData%IDC_F(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_142.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_F.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%D1_142 = SrcParamData%D1_142 + DstParamData%IDC_F = SrcParamData%IDC_F end if - if (allocated(SrcParamData%PhiM)) then - LB(1:2) = lbound(SrcParamData%PhiM) - UB(1:2) = ubound(SrcParamData%PhiM) - if (.not. allocated(DstParamData%PhiM)) then - allocate(DstParamData%PhiM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%IDR__)) then + LB(1:1) = lbound(SrcParamData%IDR__) + UB(1:1) = ubound(SrcParamData%IDR__) + if (.not. allocated(DstParamData%IDR__)) then + allocate(DstParamData%IDR__(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiM.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDR__.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%PhiM = SrcParamData%PhiM + DstParamData%IDR__ = SrcParamData%IDR__ end if - if (allocated(SrcParamData%C2_61)) then - LB(1:2) = lbound(SrcParamData%C2_61) - UB(1:2) = ubound(SrcParamData%C2_61) - if (.not. allocated(DstParamData%C2_61)) then - allocate(DstParamData%C2_61(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%ID__Rb)) then + LB(1:1) = lbound(SrcParamData%ID__Rb) + UB(1:1) = ubound(SrcParamData%ID__Rb) + if (.not. allocated(DstParamData%ID__Rb)) then + allocate(DstParamData%ID__Rb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C2_61.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__Rb.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%C2_61 = SrcParamData%C2_61 + DstParamData%ID__Rb = SrcParamData%ID__Rb end if - if (allocated(SrcParamData%C2_62)) then - LB(1:2) = lbound(SrcParamData%C2_62) - UB(1:2) = ubound(SrcParamData%C2_62) - if (.not. allocated(DstParamData%C2_62)) then - allocate(DstParamData%C2_62(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%ID__L)) then + LB(1:1) = lbound(SrcParamData%ID__L) + UB(1:1) = ubound(SrcParamData%ID__L) + if (.not. allocated(DstParamData%ID__L)) then + allocate(DstParamData%ID__L(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C2_62.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__L.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%C2_62 = SrcParamData%C2_62 + DstParamData%ID__L = SrcParamData%ID__L end if - if (allocated(SrcParamData%PhiRb_TI)) then - LB(1:2) = lbound(SrcParamData%PhiRb_TI) - UB(1:2) = ubound(SrcParamData%PhiRb_TI) - if (.not. allocated(DstParamData%PhiRb_TI)) then - allocate(DstParamData%PhiRb_TI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%ID__F)) then + LB(1:1) = lbound(SrcParamData%ID__F) + UB(1:1) = ubound(SrcParamData%ID__F) + if (.not. allocated(DstParamData%ID__F)) then + allocate(DstParamData%ID__F(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiRb_TI.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__F.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%PhiRb_TI = SrcParamData%PhiRb_TI + DstParamData%ID__F = SrcParamData%ID__F end if - if (allocated(SrcParamData%D2_63)) then - LB(1:2) = lbound(SrcParamData%D2_63) - UB(1:2) = ubound(SrcParamData%D2_63) - if (.not. allocated(DstParamData%D2_63)) then - allocate(DstParamData%D2_63(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + DstParamData%NMOutputs = SrcParamData%NMOutputs + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%OutSwtch = SrcParamData%OutSwtch + DstParamData%UnJckF = SrcParamData%UnJckF + DstParamData%Delim = SrcParamData%Delim + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%OutSFmt = SrcParamData%OutSFmt + if (allocated(SrcParamData%MoutLst)) then + LB(1:1) = lbound(SrcParamData%MoutLst) + UB(1:1) = ubound(SrcParamData%MoutLst) + if (.not. allocated(DstParamData%MoutLst)) then + allocate(DstParamData%MoutLst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_63.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%D2_63 = SrcParamData%D2_63 + do i1 = LB(1), UB(1) + call SD_CopyMeshAuxDataType(SrcParamData%MoutLst(i1), DstParamData%MoutLst(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcParamData%D2_64)) then - LB(1:2) = lbound(SrcParamData%D2_64) - UB(1:2) = ubound(SrcParamData%D2_64) - if (.not. allocated(DstParamData%D2_64)) then - allocate(DstParamData%D2_64(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%MoutLst2)) then + LB(1:1) = lbound(SrcParamData%MoutLst2) + UB(1:1) = ubound(SrcParamData%MoutLst2) + if (.not. allocated(DstParamData%MoutLst2)) then + allocate(DstParamData%MoutLst2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_64.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst2.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%D2_64 = SrcParamData%D2_64 + do i1 = LB(1), UB(1) + call SD_CopyMeshAuxDataType(SrcParamData%MoutLst2(i1), DstParamData%MoutLst2(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcParamData%MBB)) then - LB(1:2) = lbound(SrcParamData%MBB) - UB(1:2) = ubound(SrcParamData%MBB) - if (.not. allocated(DstParamData%MBB)) then - allocate(DstParamData%MBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%MoutLst3)) then + LB(1:1) = lbound(SrcParamData%MoutLst3) + UB(1:1) = ubound(SrcParamData%MoutLst3) + if (.not. allocated(DstParamData%MoutLst3)) then + allocate(DstParamData%MoutLst3(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBB.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst3.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%MBB = SrcParamData%MBB + do i1 = LB(1), UB(1) + call SD_CopyMeshAuxDataType(SrcParamData%MoutLst3(i1), DstParamData%MoutLst3(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcParamData%KBB)) then - LB(1:2) = lbound(SrcParamData%KBB) - UB(1:2) = ubound(SrcParamData%KBB) - if (.not. allocated(DstParamData%KBB)) then - allocate(DstParamData%KBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBB.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%KBB = SrcParamData%KBB + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcParamData%CBB)) then - LB(1:2) = lbound(SrcParamData%CBB) - UB(1:2) = ubound(SrcParamData%CBB) - if (.not. allocated(DstParamData%CBB)) then - allocate(DstParamData%CBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBB.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%CBB = SrcParamData%CBB + DstParamData%OutAll = SrcParamData%OutAll + DstParamData%OutCBModes = SrcParamData%OutCBModes + DstParamData%OutFEMModes = SrcParamData%OutFEMModes + DstParamData%OutReact = SrcParamData%OutReact + DstParamData%OutAllInt = SrcParamData%OutAllInt + DstParamData%OutAllDims = SrcParamData%OutAllDims + DstParamData%OutDec = SrcParamData%OutDec +end subroutine + +subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%Elems)) then + deallocate(ParamData%Elems) end if - if (allocated(SrcParamData%CMM)) then - LB(1:2) = lbound(SrcParamData%CMM) - UB(1:2) = ubound(SrcParamData%CMM) - if (.not. allocated(DstParamData%CMM)) then - allocate(DstParamData%CMM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMM.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%CMM = SrcParamData%CMM + if (allocated(ParamData%ElemProps)) then + LB(1:1) = lbound(ParamData%ElemProps) + UB(1:1) = ubound(ParamData%ElemProps) + do i1 = LB(1), UB(1) + call SD_DestroyElemPropType(ParamData%ElemProps(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%ElemProps) end if - if (allocated(SrcParamData%MBM)) then - LB(1:2) = lbound(SrcParamData%MBM) - UB(1:2) = ubound(SrcParamData%MBM) - if (.not. allocated(DstParamData%MBM)) then - allocate(DstParamData%MBM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBM.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%MBM = SrcParamData%MBM + if (allocated(ParamData%FC)) then + deallocate(ParamData%FC) end if - if (allocated(SrcParamData%PhiL_T)) then - LB(1:2) = lbound(SrcParamData%PhiL_T) - UB(1:2) = ubound(SrcParamData%PhiL_T) - if (.not. allocated(DstParamData%PhiL_T)) then - allocate(DstParamData%PhiL_T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiL_T.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%PhiL_T = SrcParamData%PhiL_T + if (allocated(ParamData%FG)) then + deallocate(ParamData%FG) end if - if (allocated(SrcParamData%PhiLInvOmgL2)) then - LB(1:2) = lbound(SrcParamData%PhiLInvOmgL2) - UB(1:2) = ubound(SrcParamData%PhiLInvOmgL2) - if (.not. allocated(DstParamData%PhiLInvOmgL2)) then - allocate(DstParamData%PhiLInvOmgL2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiLInvOmgL2.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%PhiLInvOmgL2 = SrcParamData%PhiLInvOmgL2 + if (allocated(ParamData%DP0)) then + deallocate(ParamData%DP0) end if - if (allocated(SrcParamData%KLLm1)) then - LB(1:2) = lbound(SrcParamData%KLLm1) - UB(1:2) = ubound(SrcParamData%KLLm1) - if (.not. allocated(DstParamData%KLLm1)) then - allocate(DstParamData%KLLm1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KLLm1.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%KLLm1 = SrcParamData%KLLm1 + if (allocated(ParamData%rPG)) then + deallocate(ParamData%rPG) end if - if (allocated(SrcParamData%AM2Jac)) then - LB(1:2) = lbound(SrcParamData%AM2Jac) - UB(1:2) = ubound(SrcParamData%AM2Jac) - if (.not. allocated(DstParamData%AM2Jac)) then - allocate(DstParamData%AM2Jac(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2Jac.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%AM2Jac = SrcParamData%AM2Jac + if (allocated(ParamData%NodeID2JointID)) then + deallocate(ParamData%NodeID2JointID) end if - if (allocated(SrcParamData%AM2JacPiv)) then - LB(1:1) = lbound(SrcParamData%AM2JacPiv) - UB(1:1) = ubound(SrcParamData%AM2JacPiv) - if (.not. allocated(DstParamData%AM2JacPiv)) then - allocate(DstParamData%AM2JacPiv(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2JacPiv.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%AM2JacPiv = SrcParamData%AM2JacPiv + if (allocated(ParamData%CMassNode)) then + deallocate(ParamData%CMassNode) end if - if (allocated(SrcParamData%TI)) then - LB(1:2) = lbound(SrcParamData%TI) - UB(1:2) = ubound(SrcParamData%TI) - if (.not. allocated(DstParamData%TI)) then - allocate(DstParamData%TI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TI.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%TI = SrcParamData%TI + if (allocated(ParamData%CMassWeight)) then + deallocate(ParamData%CMassWeight) end if - if (allocated(SrcParamData%TIreact)) then - LB(1:2) = lbound(SrcParamData%TIreact) - UB(1:2) = ubound(SrcParamData%TIreact) - if (.not. allocated(DstParamData%TIreact)) then - allocate(DstParamData%TIreact(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TIreact.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%TIreact = SrcParamData%TIreact + if (allocated(ParamData%CMassOffset)) then + deallocate(ParamData%CMassOffset) end if - DstParamData%nNodes = SrcParamData%nNodes - DstParamData%nNodes_I = SrcParamData%nNodes_I - DstParamData%nNodes_L = SrcParamData%nNodes_L - DstParamData%nNodes_C = SrcParamData%nNodes_C - if (allocated(SrcParamData%Nodes_I)) then - LB(1:2) = lbound(SrcParamData%Nodes_I) - UB(1:2) = ubound(SrcParamData%Nodes_I) - if (.not. allocated(DstParamData%Nodes_I)) then - allocate(DstParamData%Nodes_I(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_I.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Nodes_I = SrcParamData%Nodes_I + if (allocated(ParamData%T_red)) then + deallocate(ParamData%T_red) end if - if (allocated(SrcParamData%Nodes_L)) then - LB(1:2) = lbound(SrcParamData%Nodes_L) - UB(1:2) = ubound(SrcParamData%Nodes_L) - if (.not. allocated(DstParamData%Nodes_L)) then - allocate(DstParamData%Nodes_L(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_L.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Nodes_L = SrcParamData%Nodes_L + if (allocated(ParamData%T_red_T)) then + deallocate(ParamData%T_red_T) end if - if (allocated(SrcParamData%Nodes_C)) then - LB(1:2) = lbound(SrcParamData%Nodes_C) - UB(1:2) = ubound(SrcParamData%Nodes_C) - if (.not. allocated(DstParamData%Nodes_C)) then - allocate(DstParamData%Nodes_C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_C.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Nodes_C = SrcParamData%Nodes_C + if (allocated(ParamData%NodesDOF)) then + LB(1:1) = lbound(ParamData%NodesDOF) + UB(1:1) = ubound(ParamData%NodesDOF) + do i1 = LB(1), UB(1) + call SD_DestroyIList(ParamData%NodesDOF(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%NodesDOF) end if - DstParamData%nDOFI__ = SrcParamData%nDOFI__ - DstParamData%nDOFI_Rb = SrcParamData%nDOFI_Rb - DstParamData%nDOFI_F = SrcParamData%nDOFI_F - DstParamData%nDOFL_L = SrcParamData%nDOFL_L - DstParamData%nDOFC__ = SrcParamData%nDOFC__ - DstParamData%nDOFC_Rb = SrcParamData%nDOFC_Rb - DstParamData%nDOFC_L = SrcParamData%nDOFC_L - DstParamData%nDOFC_F = SrcParamData%nDOFC_F - DstParamData%nDOFR__ = SrcParamData%nDOFR__ - DstParamData%nDOF__Rb = SrcParamData%nDOF__Rb - DstParamData%nDOF__L = SrcParamData%nDOF__L - DstParamData%nDOF__F = SrcParamData%nDOF__F - if (allocated(SrcParamData%IDI__)) then - LB(1:1) = lbound(SrcParamData%IDI__) - UB(1:1) = ubound(SrcParamData%IDI__) - if (.not. allocated(DstParamData%IDI__)) then - allocate(DstParamData%IDI__(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI__.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDI__ = SrcParamData%IDI__ + if (allocated(ParamData%NodesDOFred)) then + LB(1:1) = lbound(ParamData%NodesDOFred) + UB(1:1) = ubound(ParamData%NodesDOFred) + do i1 = LB(1), UB(1) + call SD_DestroyIList(ParamData%NodesDOFred(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%NodesDOFred) end if - if (allocated(SrcParamData%IDI_Rb)) then - LB(1:1) = lbound(SrcParamData%IDI_Rb) - UB(1:1) = ubound(SrcParamData%IDI_Rb) - if (.not. allocated(DstParamData%IDI_Rb)) then - allocate(DstParamData%IDI_Rb(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_Rb.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDI_Rb = SrcParamData%IDI_Rb + if (allocated(ParamData%ElemsDOF)) then + deallocate(ParamData%ElemsDOF) end if - if (allocated(SrcParamData%IDI_F)) then - LB(1:1) = lbound(SrcParamData%IDI_F) - UB(1:1) = ubound(SrcParamData%IDI_F) - if (.not. allocated(DstParamData%IDI_F)) then - allocate(DstParamData%IDI_F(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_F.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDI_F = SrcParamData%IDI_F + if (allocated(ParamData%DOFred2Nodes)) then + deallocate(ParamData%DOFred2Nodes) end if - if (allocated(SrcParamData%IDL_L)) then - LB(1:1) = lbound(SrcParamData%IDL_L) - UB(1:1) = ubound(SrcParamData%IDL_L) - if (.not. allocated(DstParamData%IDL_L)) then - allocate(DstParamData%IDL_L(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDL_L.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDL_L = SrcParamData%IDL_L + if (allocated(ParamData%CtrlElem2Channel)) then + deallocate(ParamData%CtrlElem2Channel) end if - if (allocated(SrcParamData%IDC__)) then - LB(1:1) = lbound(SrcParamData%IDC__) - UB(1:1) = ubound(SrcParamData%IDC__) - if (.not. allocated(DstParamData%IDC__)) then - allocate(DstParamData%IDC__(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC__.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDC__ = SrcParamData%IDC__ + if (allocated(ParamData%KMMDiag)) then + deallocate(ParamData%KMMDiag) end if - if (allocated(SrcParamData%IDC_Rb)) then - LB(1:1) = lbound(SrcParamData%IDC_Rb) - UB(1:1) = ubound(SrcParamData%IDC_Rb) - if (.not. allocated(DstParamData%IDC_Rb)) then - allocate(DstParamData%IDC_Rb(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_Rb.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDC_Rb = SrcParamData%IDC_Rb + if (allocated(ParamData%CMMDiag)) then + deallocate(ParamData%CMMDiag) end if - if (allocated(SrcParamData%IDC_L)) then - LB(1:1) = lbound(SrcParamData%IDC_L) - UB(1:1) = ubound(SrcParamData%IDC_L) - if (.not. allocated(DstParamData%IDC_L)) then - allocate(DstParamData%IDC_L(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_L.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDC_L = SrcParamData%IDC_L + if (allocated(ParamData%MMB)) then + deallocate(ParamData%MMB) end if - if (allocated(SrcParamData%IDC_F)) then - LB(1:1) = lbound(SrcParamData%IDC_F) - UB(1:1) = ubound(SrcParamData%IDC_F) - if (.not. allocated(DstParamData%IDC_F)) then - allocate(DstParamData%IDC_F(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_F.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDC_F = SrcParamData%IDC_F + if (allocated(ParamData%MBmmB)) then + deallocate(ParamData%MBmmB) end if - if (allocated(SrcParamData%IDR__)) then - LB(1:1) = lbound(SrcParamData%IDR__) - UB(1:1) = ubound(SrcParamData%IDR__) - if (.not. allocated(DstParamData%IDR__)) then - allocate(DstParamData%IDR__(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDR__.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDR__ = SrcParamData%IDR__ - end if - if (allocated(SrcParamData%ID__Rb)) then - LB(1:1) = lbound(SrcParamData%ID__Rb) - UB(1:1) = ubound(SrcParamData%ID__Rb) - if (.not. allocated(DstParamData%ID__Rb)) then - allocate(DstParamData%ID__Rb(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__Rb.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%ID__Rb = SrcParamData%ID__Rb - end if - if (allocated(SrcParamData%ID__L)) then - LB(1:1) = lbound(SrcParamData%ID__L) - UB(1:1) = ubound(SrcParamData%ID__L) - if (.not. allocated(DstParamData%ID__L)) then - allocate(DstParamData%ID__L(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__L.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%ID__L = SrcParamData%ID__L - end if - if (allocated(SrcParamData%ID__F)) then - LB(1:1) = lbound(SrcParamData%ID__F) - UB(1:1) = ubound(SrcParamData%ID__F) - if (.not. allocated(DstParamData%ID__F)) then - allocate(DstParamData%ID__F(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__F.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%ID__F = SrcParamData%ID__F - end if - DstParamData%NMOutputs = SrcParamData%NMOutputs - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%OutSwtch = SrcParamData%OutSwtch - DstParamData%UnJckF = SrcParamData%UnJckF - DstParamData%Delim = SrcParamData%Delim - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutSFmt = SrcParamData%OutSFmt - if (allocated(SrcParamData%MoutLst)) then - LB(1:1) = lbound(SrcParamData%MoutLst) - UB(1:1) = ubound(SrcParamData%MoutLst) - if (.not. allocated(DstParamData%MoutLst)) then - allocate(DstParamData%MoutLst(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SD_CopyMeshAuxDataType(SrcParamData%MoutLst(i1), DstParamData%MoutLst(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcParamData%MoutLst2)) then - LB(1:1) = lbound(SrcParamData%MoutLst2) - UB(1:1) = ubound(SrcParamData%MoutLst2) - if (.not. allocated(DstParamData%MoutLst2)) then - allocate(DstParamData%MoutLst2(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst2.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SD_CopyMeshAuxDataType(SrcParamData%MoutLst2(i1), DstParamData%MoutLst2(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcParamData%MoutLst3)) then - LB(1:1) = lbound(SrcParamData%MoutLst3) - UB(1:1) = ubound(SrcParamData%MoutLst3) - if (.not. allocated(DstParamData%MoutLst3)) then - allocate(DstParamData%MoutLst3(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst3.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call SD_CopyMeshAuxDataType(SrcParamData%MoutLst3(i1), DstParamData%MoutLst3(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam) - UB(1:1) = ubound(SrcParamData%OutParam) - if (.not. allocated(DstParamData%OutParam)) then - allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - DstParamData%OutAll = SrcParamData%OutAll - DstParamData%OutCBModes = SrcParamData%OutCBModes - DstParamData%OutFEMModes = SrcParamData%OutFEMModes - DstParamData%OutReact = SrcParamData%OutReact - DstParamData%OutAllInt = SrcParamData%OutAllInt - DstParamData%OutAllDims = SrcParamData%OutAllDims - DstParamData%OutDec = SrcParamData%OutDec - if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx) - UB(1:2) = ubound(SrcParamData%Jac_u_indx) - if (.not. allocated(DstParamData%Jac_u_indx)) then - allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx - end if - if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du) - UB(1:1) = ubound(SrcParamData%du) - if (.not. allocated(DstParamData%du)) then - allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%du = SrcParamData%du - end if - DstParamData%dx = SrcParamData%dx - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%Jac_nx = SrcParamData%Jac_nx - DstParamData%RotStates = SrcParamData%RotStates -end subroutine - -subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) - type(SD_ParameterType), intent(inout) :: ParamData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SD_DestroyParam' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(ParamData%Elems)) then - deallocate(ParamData%Elems) - end if - if (allocated(ParamData%ElemProps)) then - LB(1:1) = lbound(ParamData%ElemProps) - UB(1:1) = ubound(ParamData%ElemProps) - do i1 = LB(1), UB(1) - call SD_DestroyElemPropType(ParamData%ElemProps(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ParamData%ElemProps) - end if - if (allocated(ParamData%FC)) then - deallocate(ParamData%FC) - end if - if (allocated(ParamData%FG)) then - deallocate(ParamData%FG) - end if - if (allocated(ParamData%DP0)) then - deallocate(ParamData%DP0) - end if - if (allocated(ParamData%rPG)) then - deallocate(ParamData%rPG) - end if - if (allocated(ParamData%NodeID2JointID)) then - deallocate(ParamData%NodeID2JointID) - end if - if (allocated(ParamData%CMassNode)) then - deallocate(ParamData%CMassNode) - end if - if (allocated(ParamData%CMassWeight)) then - deallocate(ParamData%CMassWeight) - end if - if (allocated(ParamData%CMassOffset)) then - deallocate(ParamData%CMassOffset) - end if - if (allocated(ParamData%T_red)) then - deallocate(ParamData%T_red) - end if - if (allocated(ParamData%T_red_T)) then - deallocate(ParamData%T_red_T) - end if - if (allocated(ParamData%NodesDOF)) then - LB(1:1) = lbound(ParamData%NodesDOF) - UB(1:1) = ubound(ParamData%NodesDOF) - do i1 = LB(1), UB(1) - call SD_DestroyIList(ParamData%NodesDOF(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ParamData%NodesDOF) - end if - if (allocated(ParamData%NodesDOFred)) then - LB(1:1) = lbound(ParamData%NodesDOFred) - UB(1:1) = ubound(ParamData%NodesDOFred) - do i1 = LB(1), UB(1) - call SD_DestroyIList(ParamData%NodesDOFred(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ParamData%NodesDOFred) - end if - if (allocated(ParamData%ElemsDOF)) then - deallocate(ParamData%ElemsDOF) - end if - if (allocated(ParamData%DOFred2Nodes)) then - deallocate(ParamData%DOFred2Nodes) - end if - if (allocated(ParamData%CtrlElem2Channel)) then - deallocate(ParamData%CtrlElem2Channel) - end if - if (allocated(ParamData%KMMDiag)) then - deallocate(ParamData%KMMDiag) - end if - if (allocated(ParamData%CMMDiag)) then - deallocate(ParamData%CMMDiag) - end if - if (allocated(ParamData%MMB)) then - deallocate(ParamData%MMB) - end if - if (allocated(ParamData%MBmmB)) then - deallocate(ParamData%MBmmB) - end if - if (allocated(ParamData%C1_11)) then - deallocate(ParamData%C1_11) + if (allocated(ParamData%C1_11)) then + deallocate(ParamData%C1_11) end if if (allocated(ParamData%C1_12)) then deallocate(ParamData%C1_12) @@ -3628,12 +3151,6 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) end do deallocate(ParamData%OutParam) end if - if (allocated(ParamData%Jac_u_indx)) then - deallocate(ParamData%Jac_u_indx) - end if - if (allocated(ParamData%du)) then - deallocate(ParamData%du) - end if end subroutine subroutine SD_PackParam(RF, Indata) @@ -3643,6 +3160,12 @@ subroutine SD_PackParam(RF, Indata) integer(B4Ki) :: i1, i2 integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%iVarTPMesh) + call RegPack(RF, InData%iVarLMesh) + call RegPack(RF, InData%iVarY1Mesh) + call RegPack(RF, InData%iVarY2Mesh) + call RegPack(RF, InData%iVarY3Mesh) + call RegPack(RF, InData%iVarWriteOutput) call RegPack(RF, InData%g) call RegPack(RF, InData%SDDeltaT) call RegPack(RF, InData%IntMethod) @@ -3802,12 +3325,6 @@ subroutine SD_PackParam(RF, Indata) call RegPack(RF, InData%OutAllInt) call RegPack(RF, InData%OutAllDims) call RegPack(RF, InData%OutDec) - call RegPackAlloc(RF, InData%Jac_u_indx) - call RegPackAlloc(RF, InData%du) - call RegPack(RF, InData%dx) - call RegPack(RF, InData%Jac_ny) - call RegPack(RF, InData%Jac_nx) - call RegPack(RF, InData%RotStates) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -3820,6 +3337,12 @@ subroutine SD_UnPackParam(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%iVarTPMesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarLMesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarY1Mesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarY2Mesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarY3Mesh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iVarWriteOutput); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%g); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SDDeltaT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%IntMethod); if (RegCheckErr(RF, RoutineName)) return @@ -4007,12 +3530,6 @@ subroutine SD_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%OutAllInt); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%OutAllDims); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%OutDec); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Jac_nx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%RotStates); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -4116,58 +3633,593 @@ subroutine SD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + end if +end subroutine + +subroutine SD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( OutputData%Y1Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%Y2Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%Y3Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine SD_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%Y1Mesh) + call MeshPack(RF, InData%Y2Mesh) + call MeshPack(RF, InData%Y3Mesh) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%Y1Mesh) ! Y1Mesh + call MeshUnpack(RF, OutData%Y2Mesh) ! Y2Mesh + call MeshUnpack(RF, OutData%Y3Mesh) ! Y3Mesh + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SD_MiscVarType), intent(inout) :: SrcMiscData + type(SD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%qmdotdot)) then + LB(1:1) = lbound(SrcMiscData%qmdotdot) + UB(1:1) = ubound(SrcMiscData%qmdotdot) + if (.not. allocated(DstMiscData%qmdotdot)) then + allocate(DstMiscData%qmdotdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%qmdotdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%qmdotdot = SrcMiscData%qmdotdot + end if + DstMiscData%u_TP = SrcMiscData%u_TP + DstMiscData%udot_TP = SrcMiscData%udot_TP + DstMiscData%udotdot_TP = SrcMiscData%udotdot_TP + if (allocated(SrcMiscData%F_L)) then + LB(1:1) = lbound(SrcMiscData%F_L) + UB(1:1) = ubound(SrcMiscData%F_L) + if (.not. allocated(DstMiscData%F_L)) then + allocate(DstMiscData%F_L(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_L = SrcMiscData%F_L + end if + if (allocated(SrcMiscData%F_L2)) then + LB(1:1) = lbound(SrcMiscData%F_L2) + UB(1:1) = ubound(SrcMiscData%F_L2) + if (.not. allocated(DstMiscData%F_L2)) then + allocate(DstMiscData%F_L2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_L2 = SrcMiscData%F_L2 + end if + if (allocated(SrcMiscData%UR_bar)) then + LB(1:1) = lbound(SrcMiscData%UR_bar) + UB(1:1) = ubound(SrcMiscData%UR_bar) + if (.not. allocated(DstMiscData%UR_bar)) then + allocate(DstMiscData%UR_bar(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UR_bar = SrcMiscData%UR_bar + end if + if (allocated(SrcMiscData%UR_bar_dot)) then + LB(1:1) = lbound(SrcMiscData%UR_bar_dot) + UB(1:1) = ubound(SrcMiscData%UR_bar_dot) + if (.not. allocated(DstMiscData%UR_bar_dot)) then + allocate(DstMiscData%UR_bar_dot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UR_bar_dot = SrcMiscData%UR_bar_dot + end if + if (allocated(SrcMiscData%UR_bar_dotdot)) then + LB(1:1) = lbound(SrcMiscData%UR_bar_dotdot) + UB(1:1) = ubound(SrcMiscData%UR_bar_dotdot) + if (.not. allocated(DstMiscData%UR_bar_dotdot)) then + allocate(DstMiscData%UR_bar_dotdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dotdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UR_bar_dotdot = SrcMiscData%UR_bar_dotdot + end if + if (allocated(SrcMiscData%UL)) then + LB(1:1) = lbound(SrcMiscData%UL) + UB(1:1) = ubound(SrcMiscData%UL) + if (.not. allocated(DstMiscData%UL)) then + allocate(DstMiscData%UL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL = SrcMiscData%UL + end if + if (allocated(SrcMiscData%UL_NS)) then + LB(1:1) = lbound(SrcMiscData%UL_NS) + UB(1:1) = ubound(SrcMiscData%UL_NS) + if (.not. allocated(DstMiscData%UL_NS)) then + allocate(DstMiscData%UL_NS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_NS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL_NS = SrcMiscData%UL_NS + end if + if (allocated(SrcMiscData%UL_dot)) then + LB(1:1) = lbound(SrcMiscData%UL_dot) + UB(1:1) = ubound(SrcMiscData%UL_dot) + if (.not. allocated(DstMiscData%UL_dot)) then + allocate(DstMiscData%UL_dot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL_dot = SrcMiscData%UL_dot + end if + if (allocated(SrcMiscData%UL_dotdot)) then + LB(1:1) = lbound(SrcMiscData%UL_dotdot) + UB(1:1) = ubound(SrcMiscData%UL_dotdot) + if (.not. allocated(DstMiscData%UL_dotdot)) then + allocate(DstMiscData%UL_dotdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dotdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL_dotdot = SrcMiscData%UL_dotdot + end if + if (allocated(SrcMiscData%DU_full)) then + LB(1:1) = lbound(SrcMiscData%DU_full) + UB(1:1) = ubound(SrcMiscData%DU_full) + if (.not. allocated(DstMiscData%DU_full)) then + allocate(DstMiscData%DU_full(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DU_full.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%DU_full = SrcMiscData%DU_full + end if + if (allocated(SrcMiscData%U_full)) then + LB(1:1) = lbound(SrcMiscData%U_full) + UB(1:1) = ubound(SrcMiscData%U_full) + if (.not. allocated(DstMiscData%U_full)) then + allocate(DstMiscData%U_full(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_full = SrcMiscData%U_full + end if + if (allocated(SrcMiscData%U_full_NS)) then + LB(1:1) = lbound(SrcMiscData%U_full_NS) + UB(1:1) = ubound(SrcMiscData%U_full_NS) + if (.not. allocated(DstMiscData%U_full_NS)) then + allocate(DstMiscData%U_full_NS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_NS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_full_NS = SrcMiscData%U_full_NS + end if + if (allocated(SrcMiscData%U_full_dot)) then + LB(1:1) = lbound(SrcMiscData%U_full_dot) + UB(1:1) = ubound(SrcMiscData%U_full_dot) + if (.not. allocated(DstMiscData%U_full_dot)) then + allocate(DstMiscData%U_full_dot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_full_dot = SrcMiscData%U_full_dot + end if + if (allocated(SrcMiscData%U_full_dotdot)) then + LB(1:1) = lbound(SrcMiscData%U_full_dotdot) + UB(1:1) = ubound(SrcMiscData%U_full_dotdot) + if (.not. allocated(DstMiscData%U_full_dotdot)) then + allocate(DstMiscData%U_full_dotdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dotdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_full_dotdot = SrcMiscData%U_full_dotdot + end if + if (allocated(SrcMiscData%U_full_elast)) then + LB(1:1) = lbound(SrcMiscData%U_full_elast) + UB(1:1) = ubound(SrcMiscData%U_full_elast) + if (.not. allocated(DstMiscData%U_full_elast)) then + allocate(DstMiscData%U_full_elast(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_elast.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_full_elast = SrcMiscData%U_full_elast + end if + if (allocated(SrcMiscData%U_red)) then + LB(1:1) = lbound(SrcMiscData%U_red) + UB(1:1) = ubound(SrcMiscData%U_red) + if (.not. allocated(DstMiscData%U_red)) then + allocate(DstMiscData%U_red(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_red.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_red = SrcMiscData%U_red + end if + if (allocated(SrcMiscData%x_full)) then + LB(1:1) = lbound(SrcMiscData%x_full) + UB(1:1) = ubound(SrcMiscData%x_full) + if (.not. allocated(DstMiscData%x_full)) then + allocate(DstMiscData%x_full(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%x_full.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%x_full = SrcMiscData%x_full + end if + if (allocated(SrcMiscData%FC_unit)) then + LB(1:1) = lbound(SrcMiscData%FC_unit) + UB(1:1) = ubound(SrcMiscData%FC_unit) + if (.not. allocated(DstMiscData%FC_unit)) then + allocate(DstMiscData%FC_unit(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FC_unit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FC_unit = SrcMiscData%FC_unit + end if + if (allocated(SrcMiscData%SDWrOutput)) then + LB(1:1) = lbound(SrcMiscData%SDWrOutput) + UB(1:1) = ubound(SrcMiscData%SDWrOutput) + if (.not. allocated(DstMiscData%SDWrOutput)) then + allocate(DstMiscData%SDWrOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SDWrOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SDWrOutput = SrcMiscData%SDWrOutput + end if + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AllOuts = SrcMiscData%AllOuts + end if + DstMiscData%LastOutTime = SrcMiscData%LastOutTime + DstMiscData%Decimat = SrcMiscData%Decimat + if (allocated(SrcMiscData%Fext)) then + LB(1:1) = lbound(SrcMiscData%Fext) + UB(1:1) = ubound(SrcMiscData%Fext) + if (.not. allocated(DstMiscData%Fext)) then + allocate(DstMiscData%Fext(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Fext = SrcMiscData%Fext + end if + if (allocated(SrcMiscData%Fext_red)) then + LB(1:1) = lbound(SrcMiscData%Fext_red) + UB(1:1) = ubound(SrcMiscData%Fext_red) + if (.not. allocated(DstMiscData%Fext_red)) then + allocate(DstMiscData%Fext_red(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext_red.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Fext_red = SrcMiscData%Fext_red + end if + if (allocated(SrcMiscData%FG)) then + LB(1:1) = lbound(SrcMiscData%FG) + UB(1:1) = ubound(SrcMiscData%FG) + if (.not. allocated(DstMiscData%FG)) then + allocate(DstMiscData%FG(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FG.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%WriteOutput = SrcOutputData%WriteOutput + DstMiscData%FG = SrcMiscData%FG + end if + if (allocated(SrcMiscData%UL_SIM)) then + LB(1:1) = lbound(SrcMiscData%UL_SIM) + UB(1:1) = ubound(SrcMiscData%UL_SIM) + if (.not. allocated(DstMiscData%UL_SIM)) then + allocate(DstMiscData%UL_SIM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_SIM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL_SIM = SrcMiscData%UL_SIM + end if + if (allocated(SrcMiscData%UL_0m)) then + LB(1:1) = lbound(SrcMiscData%UL_0m) + UB(1:1) = ubound(SrcMiscData%UL_0m) + if (.not. allocated(DstMiscData%UL_0m)) then + allocate(DstMiscData%UL_0m(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_0m.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL_0m = SrcMiscData%UL_0m end if end subroutine -subroutine SD_DestroyOutput(OutputData, ErrStat, ErrMsg) - type(SD_OutputType), intent(inout) :: OutputData +subroutine SD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SD_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SD_DestroyOutput' + character(*), parameter :: RoutineName = 'SD_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' - call MeshDestroy( OutputData%Y1Mesh, ErrStat2, ErrMsg2) + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( OutputData%Y2Mesh, ErrStat2, ErrMsg2) + call SD_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( OutputData%Y3Mesh, ErrStat2, ErrMsg2) + call SD_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(OutputData%WriteOutput)) then - deallocate(OutputData%WriteOutput) + call SD_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SD_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%qmdotdot)) then + deallocate(MiscData%qmdotdot) + end if + if (allocated(MiscData%F_L)) then + deallocate(MiscData%F_L) + end if + if (allocated(MiscData%F_L2)) then + deallocate(MiscData%F_L2) + end if + if (allocated(MiscData%UR_bar)) then + deallocate(MiscData%UR_bar) + end if + if (allocated(MiscData%UR_bar_dot)) then + deallocate(MiscData%UR_bar_dot) + end if + if (allocated(MiscData%UR_bar_dotdot)) then + deallocate(MiscData%UR_bar_dotdot) + end if + if (allocated(MiscData%UL)) then + deallocate(MiscData%UL) + end if + if (allocated(MiscData%UL_NS)) then + deallocate(MiscData%UL_NS) + end if + if (allocated(MiscData%UL_dot)) then + deallocate(MiscData%UL_dot) + end if + if (allocated(MiscData%UL_dotdot)) then + deallocate(MiscData%UL_dotdot) + end if + if (allocated(MiscData%DU_full)) then + deallocate(MiscData%DU_full) + end if + if (allocated(MiscData%U_full)) then + deallocate(MiscData%U_full) + end if + if (allocated(MiscData%U_full_NS)) then + deallocate(MiscData%U_full_NS) + end if + if (allocated(MiscData%U_full_dot)) then + deallocate(MiscData%U_full_dot) + end if + if (allocated(MiscData%U_full_dotdot)) then + deallocate(MiscData%U_full_dotdot) + end if + if (allocated(MiscData%U_full_elast)) then + deallocate(MiscData%U_full_elast) + end if + if (allocated(MiscData%U_red)) then + deallocate(MiscData%U_red) + end if + if (allocated(MiscData%x_full)) then + deallocate(MiscData%x_full) + end if + if (allocated(MiscData%FC_unit)) then + deallocate(MiscData%FC_unit) + end if + if (allocated(MiscData%SDWrOutput)) then + deallocate(MiscData%SDWrOutput) + end if + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if + if (allocated(MiscData%Fext)) then + deallocate(MiscData%Fext) + end if + if (allocated(MiscData%Fext_red)) then + deallocate(MiscData%Fext_red) + end if + if (allocated(MiscData%FG)) then + deallocate(MiscData%FG) + end if + if (allocated(MiscData%UL_SIM)) then + deallocate(MiscData%UL_SIM) + end if + if (allocated(MiscData%UL_0m)) then + deallocate(MiscData%UL_0m) end if end subroutine -subroutine SD_PackOutput(RF, Indata) +subroutine SD_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF - type(SD_OutputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SD_PackOutput' + type(SD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackMisc' if (RF%ErrStat >= AbortErrLev) return - call MeshPack(RF, InData%Y1Mesh) - call MeshPack(RF, InData%Y2Mesh) - call MeshPack(RF, InData%Y3Mesh) - call RegPackAlloc(RF, InData%WriteOutput) + call NWTC_Library_PackModJacType(RF, InData%Jac) + call SD_PackContState(RF, InData%x_perturb) + call SD_PackContState(RF, InData%dxdt_lin) + call SD_PackInput(RF, InData%u_perturb) + call SD_PackOutput(RF, InData%y_lin) + call RegPackAlloc(RF, InData%qmdotdot) + call RegPack(RF, InData%u_TP) + call RegPack(RF, InData%udot_TP) + call RegPack(RF, InData%udotdot_TP) + call RegPackAlloc(RF, InData%F_L) + call RegPackAlloc(RF, InData%F_L2) + call RegPackAlloc(RF, InData%UR_bar) + call RegPackAlloc(RF, InData%UR_bar_dot) + call RegPackAlloc(RF, InData%UR_bar_dotdot) + call RegPackAlloc(RF, InData%UL) + call RegPackAlloc(RF, InData%UL_NS) + call RegPackAlloc(RF, InData%UL_dot) + call RegPackAlloc(RF, InData%UL_dotdot) + call RegPackAlloc(RF, InData%DU_full) + call RegPackAlloc(RF, InData%U_full) + call RegPackAlloc(RF, InData%U_full_NS) + call RegPackAlloc(RF, InData%U_full_dot) + call RegPackAlloc(RF, InData%U_full_dotdot) + call RegPackAlloc(RF, InData%U_full_elast) + call RegPackAlloc(RF, InData%U_red) + call RegPackAlloc(RF, InData%x_full) + call RegPackAlloc(RF, InData%FC_unit) + call RegPackAlloc(RF, InData%SDWrOutput) + call RegPackAlloc(RF, InData%AllOuts) + call RegPack(RF, InData%LastOutTime) + call RegPack(RF, InData%Decimat) + call RegPackAlloc(RF, InData%Fext) + call RegPackAlloc(RF, InData%Fext_red) + call RegPackAlloc(RF, InData%FG) + call RegPackAlloc(RF, InData%UL_SIM) + call RegPackAlloc(RF, InData%UL_0m) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SD_UnPackOutput(RF, OutData) +subroutine SD_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF - type(SD_OutputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SD_UnPackOutput' + type(SD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackMisc' integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call MeshUnpack(RF, OutData%Y1Mesh) ! Y1Mesh - call MeshUnpack(RF, OutData%Y2Mesh) ! Y2Mesh - call MeshUnpack(RF, OutData%Y3Mesh) ! Y3Mesh - call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call SD_UnpackContState(RF, OutData%x_perturb) ! x_perturb + call SD_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin + call SD_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call SD_UnpackOutput(RF, OutData%y_lin) ! y_lin + call RegUnpackAlloc(RF, OutData%qmdotdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%u_TP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%udot_TP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%udotdot_TP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_L); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_L2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UR_bar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UR_bar_dot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UR_bar_dotdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL_NS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL_dot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL_dotdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DU_full); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_full); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_full_NS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_full_dot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_full_dotdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_full_elast); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_red); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_full); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FC_unit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SDWrOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Decimat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fext); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fext_red); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL_SIM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL_0m); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) @@ -4513,5 +4565,325 @@ SUBROUTINE SD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated END SUBROUTINE + +function SD_InputMeshPointer(u, DL) result(Mesh) + type(SD_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (SD_u_TPMesh) + Mesh => u%TPMesh + case (SD_u_LMesh) + Mesh => u%LMesh + end select +end function + +function SD_OutputMeshPointer(y, DL) result(Mesh) + type(SD_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (SD_y_Y1Mesh) + Mesh => y%Y1Mesh + case (SD_y_Y2Mesh) + Mesh => y%Y2Mesh + case (SD_y_Y3Mesh) + Mesh => y%Y3Mesh + end select +end function + +subroutine SD_VarsPackContState(Vars, x, ValAry) + type(SD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SD_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine SD_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SD_x_qm) + VarVals = x%qm(V%iLB:V%iUB) ! Rank 1 Array + case (SD_x_qmdot) + VarVals = x%qmdot(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SD_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SD_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine SD_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SD_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SD_x_qm) + x%qm(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SD_x_qmdot) + x%qmdot(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function SD_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SD_x_qm) + Name = "x%qm" + case (SD_x_qmdot) + Name = "x%qmdot" + case default + Name = "Unknown Field" + end select +end function + +subroutine SD_VarsPackContStateDeriv(Vars, x, ValAry) + type(SD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SD_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine SD_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SD_x_qm) + VarVals = x%qm(V%iLB:V%iUB) ! Rank 1 Array + case (SD_x_qmdot) + VarVals = x%qmdot(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SD_VarsPackConstrState(Vars, z, ValAry) + type(SD_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call SD_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine SD_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(SD_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SD_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SD_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SD_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call SD_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine SD_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SD_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SD_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function SD_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SD_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine SD_VarsPackInput(Vars, u, ValAry) + type(SD_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call SD_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine SD_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(SD_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SD_u_TPMesh) + call MV_PackMesh(V, u%TPMesh, ValAry) ! Mesh + case (SD_u_LMesh) + call MV_PackMesh(V, u%LMesh, ValAry) ! Mesh + case (SD_u_CableDeltaL) + VarVals = u%CableDeltaL(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SD_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SD_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call SD_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine SD_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SD_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SD_u_TPMesh) + call MV_UnpackMesh(V, ValAry, u%TPMesh) ! Mesh + case (SD_u_LMesh) + call MV_UnpackMesh(V, ValAry, u%LMesh) ! Mesh + case (SD_u_CableDeltaL) + u%CableDeltaL(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function SD_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SD_u_TPMesh) + Name = "u%TPMesh" + case (SD_u_LMesh) + Name = "u%LMesh" + case (SD_u_CableDeltaL) + Name = "u%CableDeltaL" + case default + Name = "Unknown Field" + end select +end function + +subroutine SD_VarsPackOutput(Vars, y, ValAry) + type(SD_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call SD_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine SD_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(SD_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SD_y_Y1Mesh) + call MV_PackMesh(V, y%Y1Mesh, ValAry) ! Mesh + case (SD_y_Y2Mesh) + call MV_PackMesh(V, y%Y2Mesh, ValAry) ! Mesh + case (SD_y_Y3Mesh) + call MV_PackMesh(V, y%Y3Mesh, ValAry) ! Mesh + case (SD_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SD_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SD_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call SD_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine SD_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SD_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SD_y_Y1Mesh) + call MV_UnpackMesh(V, ValAry, y%Y1Mesh) ! Mesh + case (SD_y_Y2Mesh) + call MV_UnpackMesh(V, ValAry, y%Y2Mesh) ! Mesh + case (SD_y_Y3Mesh) + call MV_UnpackMesh(V, ValAry, y%Y3Mesh) ! Mesh + case (SD_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function SD_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SD_y_Y1Mesh) + Name = "y%Y1Mesh" + case (SD_y_Y2Mesh) + Name = "y%Y2Mesh" + case (SD_y_Y3Mesh) + Name = "y%Y3Mesh" + case (SD_y_WriteOutput) + Name = "y%WriteOutput" + case default + Name = "Unknown Field" + end select +end function + END MODULE SubDyn_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/supercontroller/src/SCDataEx_Types.f90 b/modules/supercontroller/src/SCDataEx_Types.f90 index cd6da16d1f..0dae968b1b 100644 --- a/modules/supercontroller/src/SCDataEx_Types.f90 +++ b/modules/supercontroller/src/SCDataEx_Types.f90 @@ -91,7 +91,11 @@ MODULE SCDataEx_Types REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: fromSCglob => NULL() !< turbine specific outputs of the super controller (to the turbine controller) [-] END TYPE SC_DX_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: SC_DX_u_toSC = 1 ! SC_DX%toSC + integer(IntKi), public, parameter :: SC_DX_y_fromSC = 2 ! SC_DX%fromSC + integer(IntKi), public, parameter :: SC_DX_y_fromSCglob = 3 ! SC_DX%fromSCglob + +contains subroutine SC_DX_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(SC_DX_InitInputType), intent(in) :: SrcInitInputData @@ -656,5 +660,145 @@ SUBROUTINE SC_DX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) END IF END IF END SUBROUTINE + +function SC_DX_InputMeshPointer(u, DL) result(Mesh) + type(SC_DX_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +function SC_DX_OutputMeshPointer(y, DL) result(Mesh) + type(SC_DX_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +subroutine SC_DX_VarsPackInput(Vars, u, ValAry) + type(SC_DX_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call SC_DX_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine SC_DX_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(SC_DX_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_DX_u_toSC) + VarVals = u%toSC(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SC_DX_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SC_DX_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call SC_DX_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine SC_DX_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SC_DX_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_DX_u_toSC) + u%toSC(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function SC_DX_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SC_DX_u_toSC) + Name = "u%toSC" + case default + Name = "Unknown Field" + end select +end function + +subroutine SC_DX_VarsPackOutput(Vars, y, ValAry) + type(SC_DX_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call SC_DX_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine SC_DX_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(SC_DX_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_DX_y_fromSC) + VarVals = y%fromSC(V%iLB:V%iUB) ! Rank 1 Array + case (SC_DX_y_fromSCglob) + VarVals = y%fromSCglob(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SC_DX_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SC_DX_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call SC_DX_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine SC_DX_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SC_DX_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_DX_y_fromSC) + y%fromSC(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SC_DX_y_fromSCglob) + y%fromSCglob(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function SC_DX_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SC_DX_y_fromSC) + Name = "y%fromSC" + case (SC_DX_y_fromSCglob) + Name = "y%fromSCglob" + case default + Name = "Unknown Field" + end select +end function + END MODULE SCDataEx_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index b811ad3465..241ba3fa3f 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -179,7 +179,14 @@ MODULE SuperController_Types REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: fromSC => NULL() !< Turbine specific outputs of the super controller (to the turbine controller) [-] END TYPE SC_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: SC_x_Dummy = 1 ! SC%Dummy + integer(IntKi), public, parameter :: SC_z_Dummy = 2 ! SC%Dummy + integer(IntKi), public, parameter :: SC_u_toSCglob = 3 ! SC%toSCglob + integer(IntKi), public, parameter :: SC_u_toSC = 4 ! SC%toSC + integer(IntKi), public, parameter :: SC_y_fromSCglob = 5 ! SC%fromSCglob + integer(IntKi), public, parameter :: SC_y_fromSC = 6 ! SC%fromSC + +contains subroutine SC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) type(SC_InitInputType), intent(in) :: SrcInitInputData @@ -1821,5 +1828,289 @@ SUBROUTINE SC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err y_out%fromSC = a1*y1%fromSC + a2*y2%fromSC + a3*y3%fromSC END IF ! check if allocated END SUBROUTINE + +function SC_InputMeshPointer(u, DL) result(Mesh) + type(SC_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +function SC_OutputMeshPointer(y, DL) result(Mesh) + type(SC_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +subroutine SC_VarsPackContState(Vars, x, ValAry) + type(SC_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SC_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine SC_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SC_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_x_Dummy) + VarVals(1) = x%Dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SC_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SC_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SC_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine SC_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SC_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_x_Dummy) + x%Dummy = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function SC_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SC_x_Dummy) + Name = "x%Dummy" + case default + Name = "Unknown Field" + end select +end function + +subroutine SC_VarsPackContStateDeriv(Vars, x, ValAry) + type(SC_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SC_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine SC_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SC_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_x_Dummy) + VarVals(1) = x%Dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SC_VarsPackConstrState(Vars, z, ValAry) + type(SC_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call SC_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine SC_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(SC_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_z_Dummy) + VarVals(1) = z%Dummy ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SC_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SC_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call SC_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine SC_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SC_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_z_Dummy) + z%Dummy = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function SC_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SC_z_Dummy) + Name = "z%Dummy" + case default + Name = "Unknown Field" + end select +end function + +subroutine SC_VarsPackInput(Vars, u, ValAry) + type(SC_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call SC_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine SC_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(SC_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_u_toSCglob) + VarVals = u%toSCglob(V%iLB:V%iUB) ! Rank 1 Array + case (SC_u_toSC) + VarVals = u%toSC(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SC_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SC_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call SC_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine SC_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SC_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_u_toSCglob) + u%toSCglob(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SC_u_toSC) + u%toSC(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function SC_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SC_u_toSCglob) + Name = "u%toSCglob" + case (SC_u_toSC) + Name = "u%toSC" + case default + Name = "Unknown Field" + end select +end function + +subroutine SC_VarsPackOutput(Vars, y, ValAry) + type(SC_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call SC_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine SC_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(SC_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_y_fromSCglob) + VarVals = y%fromSCglob(V%iLB:V%iUB) ! Rank 1 Array + case (SC_y_fromSC) + VarVals = y%fromSC(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SC_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SC_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call SC_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine SC_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SC_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SC_y_fromSCglob) + y%fromSCglob(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SC_y_fromSC) + y%fromSC(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function SC_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SC_y_fromSCglob) + Name = "y%fromSCglob" + case (SC_y_fromSC) + Name = "y%fromSC" + case default + Name = "Unknown Field" + end select +end function + END MODULE SuperController_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/wakedynamics/src/WakeDynamics_Types.f90 b/modules/wakedynamics/src/WakeDynamics_Types.f90 index 289e7e42b8..455ca50cfc 100644 --- a/modules/wakedynamics/src/WakeDynamics_Types.f90 +++ b/modules/wakedynamics/src/WakeDynamics_Types.f90 @@ -33,13 +33,13 @@ MODULE WakeDynamics_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: WakeDiamMod_RotDiam = 1 ! Wake diameter calculation model: rotor diameter [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WakeDiamMod_Velocity = 2 ! Wake diameter calculation model: velocity-based [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WakeDiamMod_MassFlux = 3 ! Wake diameter calculation model: mass-flux based [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WakeDiamMod_MtmFlux = 4 ! Wake diameter calculation model: momentum-flux based [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_Wake_Polar = 1 ! Wake model [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_Wake_Curl = 2 ! Wake model [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_Wake_Cartesian = 3 ! Wake model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WakeDiamMod_RotDiam = 1 ! Wake diameter calculation model: rotor diameter [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WakeDiamMod_Velocity = 2 ! Wake diameter calculation model: velocity-based [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WakeDiamMod_MassFlux = 3 ! Wake diameter calculation model: mass-flux based [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WakeDiamMod_MtmFlux = 4 ! Wake diameter calculation model: momentum-flux based [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_Wake_Polar = 1 ! Wake model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_Wake_Curl = 2 ! Wake model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_Wake_Cartesian = 3 ! Wake model [-] ! ========= WD_InputFileType ======= TYPE, PUBLIC :: WD_InputFileType REAL(ReKi) :: dr = 0.0_ReKi !< Radial increment of radial finite-difference grid [>0.0] [m] @@ -244,7 +244,32 @@ MODULE WakeDynamics_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WAT_k !< Scaling factor k_mt(iP,y,z) for wake-added turbulence [-] END TYPE WD_OutputType ! ======================= -CONTAINS + integer(IntKi), public, parameter :: WD_x_DummyContState = 1 ! WD%DummyContState + integer(IntKi), public, parameter :: WD_z_DummyConstrState = 2 ! WD%DummyConstrState + integer(IntKi), public, parameter :: WD_u_xhat_disk = 3 ! WD%xhat_disk + integer(IntKi), public, parameter :: WD_u_YawErr = 4 ! WD%YawErr + integer(IntKi), public, parameter :: WD_u_psi_skew = 5 ! WD%psi_skew + integer(IntKi), public, parameter :: WD_u_chi_skew = 6 ! WD%chi_skew + integer(IntKi), public, parameter :: WD_u_p_hub = 7 ! WD%p_hub + integer(IntKi), public, parameter :: WD_u_V_plane = 8 ! WD%V_plane + integer(IntKi), public, parameter :: WD_u_Vx_wind_disk = 9 ! WD%Vx_wind_disk + integer(IntKi), public, parameter :: WD_u_TI_amb = 10 ! WD%TI_amb + integer(IntKi), public, parameter :: WD_u_D_rotor = 11 ! WD%D_rotor + integer(IntKi), public, parameter :: WD_u_Vx_rel_disk = 12 ! WD%Vx_rel_disk + integer(IntKi), public, parameter :: WD_u_Ct_azavg = 13 ! WD%Ct_azavg + integer(IntKi), public, parameter :: WD_u_Cq_azavg = 14 ! WD%Cq_azavg + integer(IntKi), public, parameter :: WD_y_xhat_plane = 15 ! WD%xhat_plane + integer(IntKi), public, parameter :: WD_y_p_plane = 16 ! WD%p_plane + integer(IntKi), public, parameter :: WD_y_Vx_wake = 17 ! WD%Vx_wake + integer(IntKi), public, parameter :: WD_y_Vr_wake = 18 ! WD%Vr_wake + integer(IntKi), public, parameter :: WD_y_Vx_wake2 = 19 ! WD%Vx_wake2 + integer(IntKi), public, parameter :: WD_y_Vy_wake2 = 20 ! WD%Vy_wake2 + integer(IntKi), public, parameter :: WD_y_Vz_wake2 = 21 ! WD%Vz_wake2 + integer(IntKi), public, parameter :: WD_y_D_wake = 22 ! WD%D_wake + integer(IntKi), public, parameter :: WD_y_x_plane = 23 ! WD%x_plane + integer(IntKi), public, parameter :: WD_y_WAT_k = 24 ! WD%WAT_k + +contains subroutine WD_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg) type(WD_InputFileType), intent(in) :: SrcInputFileTypeData @@ -1911,5 +1936,397 @@ subroutine WD_UnPackOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%x_plane); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WAT_k); if (RegCheckErr(RF, RoutineName)) return end subroutine + +function WD_InputMeshPointer(u, DL) result(Mesh) + type(WD_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +function WD_OutputMeshPointer(y, DL) result(Mesh) + type(WD_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + end select +end function + +subroutine WD_VarsPackContState(Vars, x, ValAry) + type(WD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call WD_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine WD_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(WD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WD_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WD_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call WD_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine WD_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(WD_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WD_x_DummyContState) + x%DummyContState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function WD_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (WD_x_DummyContState) + Name = "x%DummyContState" + case default + Name = "Unknown Field" + end select +end function + +subroutine WD_VarsPackContStateDeriv(Vars, x, ValAry) + type(WD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call WD_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine WD_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(WD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WD_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WD_VarsPackConstrState(Vars, z, ValAry) + type(WD_ConstraintStateType), intent(in) :: z + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%z) + call WD_VarPackConstrState(Vars%z(i), z, ValAry) + end do +end subroutine + +subroutine WD_VarPackConstrState(V, z, ValAry) + type(ModVarType), intent(in) :: V + type(WD_ConstraintStateType), intent(in) :: z + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WD_z_DummyConstrState) + VarVals(1) = z%DummyConstrState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WD_VarsUnpackConstrState(Vars, ValAry, z) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WD_ConstraintStateType), intent(inout) :: z + integer(IntKi) :: i + do i = 1, size(Vars%z) + call WD_VarUnpackConstrState(Vars%z(i), ValAry, z) + end do +end subroutine + +subroutine WD_VarUnpackConstrState(V, ValAry, z) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(WD_ConstraintStateType), intent(inout) :: z + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WD_z_DummyConstrState) + z%DummyConstrState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function WD_ConstraintStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (WD_z_DummyConstrState) + Name = "z%DummyConstrState" + case default + Name = "Unknown Field" + end select +end function + +subroutine WD_VarsPackInput(Vars, u, ValAry) + type(WD_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call WD_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine WD_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(WD_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WD_u_xhat_disk) + VarVals = u%xhat_disk(V%iLB:V%iUB) ! Rank 1 Array + case (WD_u_YawErr) + VarVals(1) = u%YawErr ! Scalar + case (WD_u_psi_skew) + VarVals(1) = u%psi_skew ! Scalar + case (WD_u_chi_skew) + VarVals(1) = u%chi_skew ! Scalar + case (WD_u_p_hub) + VarVals = u%p_hub(V%iLB:V%iUB) ! Rank 1 Array + case (WD_u_V_plane) + VarVals = u%V_plane(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (WD_u_Vx_wind_disk) + VarVals(1) = u%Vx_wind_disk ! Scalar + case (WD_u_TI_amb) + VarVals(1) = u%TI_amb ! Scalar + case (WD_u_D_rotor) + VarVals(1) = u%D_rotor ! Scalar + case (WD_u_Vx_rel_disk) + VarVals(1) = u%Vx_rel_disk ! Scalar + case (WD_u_Ct_azavg) + VarVals = u%Ct_azavg(V%iLB:V%iUB) ! Rank 1 Array + case (WD_u_Cq_azavg) + VarVals = u%Cq_azavg(V%iLB:V%iUB) ! Rank 1 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WD_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WD_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call WD_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine WD_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(WD_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WD_u_xhat_disk) + u%xhat_disk(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (WD_u_YawErr) + u%YawErr = VarVals(1) ! Scalar + case (WD_u_psi_skew) + u%psi_skew = VarVals(1) ! Scalar + case (WD_u_chi_skew) + u%chi_skew = VarVals(1) ! Scalar + case (WD_u_p_hub) + u%p_hub(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (WD_u_V_plane) + u%V_plane(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (WD_u_Vx_wind_disk) + u%Vx_wind_disk = VarVals(1) ! Scalar + case (WD_u_TI_amb) + u%TI_amb = VarVals(1) ! Scalar + case (WD_u_D_rotor) + u%D_rotor = VarVals(1) ! Scalar + case (WD_u_Vx_rel_disk) + u%Vx_rel_disk = VarVals(1) ! Scalar + case (WD_u_Ct_azavg) + u%Ct_azavg(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (WD_u_Cq_azavg) + u%Cq_azavg(V%iLB:V%iUB) = VarVals ! Rank 1 Array + end select + end associate +end subroutine + +function WD_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (WD_u_xhat_disk) + Name = "u%xhat_disk" + case (WD_u_YawErr) + Name = "u%YawErr" + case (WD_u_psi_skew) + Name = "u%psi_skew" + case (WD_u_chi_skew) + Name = "u%chi_skew" + case (WD_u_p_hub) + Name = "u%p_hub" + case (WD_u_V_plane) + Name = "u%V_plane" + case (WD_u_Vx_wind_disk) + Name = "u%Vx_wind_disk" + case (WD_u_TI_amb) + Name = "u%TI_amb" + case (WD_u_D_rotor) + Name = "u%D_rotor" + case (WD_u_Vx_rel_disk) + Name = "u%Vx_rel_disk" + case (WD_u_Ct_azavg) + Name = "u%Ct_azavg" + case (WD_u_Cq_azavg) + Name = "u%Cq_azavg" + case default + Name = "Unknown Field" + end select +end function + +subroutine WD_VarsPackOutput(Vars, y, ValAry) + type(WD_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call WD_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine WD_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(WD_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WD_y_xhat_plane) + VarVals = y%xhat_plane(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (WD_y_p_plane) + VarVals = y%p_plane(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (WD_y_Vx_wake) + VarVals = y%Vx_wake(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (WD_y_Vr_wake) + VarVals = y%Vr_wake(V%iLB:V%iUB,V%j) ! Rank 2 Array + case (WD_y_Vx_wake2) + VarVals = y%Vx_wake2(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (WD_y_Vy_wake2) + VarVals = y%Vy_wake2(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (WD_y_Vz_wake2) + VarVals = y%Vz_wake2(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case (WD_y_D_wake) + VarVals = y%D_wake(V%iLB:V%iUB) ! Rank 1 Array + case (WD_y_x_plane) + VarVals = y%x_plane(V%iLB:V%iUB) ! Rank 1 Array + case (WD_y_WAT_k) + VarVals = y%WAT_k(V%iLB:V%iUB, V%j, V%k) ! Rank 3 Array + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine WD_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(WD_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call WD_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine WD_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(WD_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (WD_y_xhat_plane) + y%xhat_plane(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (WD_y_p_plane) + y%p_plane(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (WD_y_Vx_wake) + y%Vx_wake(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (WD_y_Vr_wake) + y%Vr_wake(V%iLB:V%iUB, V%j) = VarVals ! Rank 2 Array + case (WD_y_Vx_wake2) + y%Vx_wake2(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (WD_y_Vy_wake2) + y%Vy_wake2(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (WD_y_Vz_wake2) + y%Vz_wake2(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + case (WD_y_D_wake) + y%D_wake(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (WD_y_x_plane) + y%x_plane(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (WD_y_WAT_k) + y%WAT_k(V%iLB:V%iUB, V%j, V%k) = VarVals ! Rank 3 Array + end select + end associate +end subroutine + +function WD_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (WD_y_xhat_plane) + Name = "y%xhat_plane" + case (WD_y_p_plane) + Name = "y%p_plane" + case (WD_y_Vx_wake) + Name = "y%Vx_wake" + case (WD_y_Vr_wake) + Name = "y%Vr_wake" + case (WD_y_Vx_wake2) + Name = "y%Vx_wake2" + case (WD_y_Vy_wake2) + Name = "y%Vy_wake2" + case (WD_y_Vz_wake2) + Name = "y%Vz_wake2" + case (WD_y_D_wake) + Name = "y%D_wake" + case (WD_y_x_plane) + Name = "y%x_plane" + case (WD_y_WAT_k) + Name = "y%WAT_k" + case default + Name = "Unknown Field" + end select +end function + END MODULE WakeDynamics_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/openfast_io/openfast_io/FAST_reader.py b/openfast_io/openfast_io/FAST_reader.py index 72bf38087e..9f64d7d946 100644 --- a/openfast_io/openfast_io/FAST_reader.py +++ b/openfast_io/openfast_io/FAST_reader.py @@ -279,6 +279,9 @@ def read_MainInput(self): self.fst_vt['Fst']['DT'] = float_read(f.readline().split()[0]) self.fst_vt['Fst']['InterpOrder'] = int(f.readline().split()[0]) self.fst_vt['Fst']['NumCrctn'] = int(f.readline().split()[0]) + self.fst_vt['Fst']['RhoInf'] = float_read(f.readline().split()[0]) + self.fst_vt['Fst']['ConvTol'] = float_read(f.readline().split()[0]) + self.fst_vt['Fst']['MaxConvIter'] = int(f.readline().split()[0]) self.fst_vt['Fst']['DT_UJac'] = float_read(f.readline().split()[0]) self.fst_vt['Fst']['UJacSclFact'] = float_read(f.readline().split()[0]) @@ -1039,7 +1042,6 @@ def read_AeroDyn(self): self.fst_vt['AeroDyn']['TwrShadow'] = int(f.readline().split()[0]) self.fst_vt['AeroDyn']['TwrAero'] = bool_read(f.readline().split()[0]) self.fst_vt['AeroDyn']['CavitCheck'] = bool_read(f.readline().split()[0]) - self.fst_vt['AeroDyn']['Buoyancy'] = bool_read(f.readline().split()[0]) self.fst_vt['AeroDyn']['NacelleDrag'] = bool_read(f.readline().split()[0]) self.fst_vt['AeroDyn']['CompAA'] = bool_read(f.readline().split()[0]) self.fst_vt['AeroDyn']['AA_InputFile'] = f.readline().split()[0] @@ -1157,6 +1159,8 @@ def read_AeroDyn(self): self.fst_vt['AeroDyn']['TwrCd'] = [None]*self.fst_vt['AeroDyn']['NumTwrNds'] self.fst_vt['AeroDyn']['TwrTI'] = [None]*self.fst_vt['AeroDyn']['NumTwrNds'] self.fst_vt['AeroDyn']['TwrCb'] = [None]*self.fst_vt['AeroDyn']['NumTwrNds'] + self.fst_vt['AeroDyn']['TwrCp'] = [None]*self.fst_vt['AeroDyn']['NumTwrNds'] + self.fst_vt['AeroDyn']['TwrCa'] = [None]*self.fst_vt['AeroDyn']['NumTwrNds'] for i in range(self.fst_vt['AeroDyn']['NumTwrNds']): data = [float(val) for val in f.readline().split()] self.fst_vt['AeroDyn']['TwrElev'][i] = data[0] @@ -1164,6 +1168,8 @@ def read_AeroDyn(self): self.fst_vt['AeroDyn']['TwrCd'][i] = data[2] self.fst_vt['AeroDyn']['TwrTI'][i] = data[3] self.fst_vt['AeroDyn']['TwrCb'][i] = data[4] + self.fst_vt['AeroDyn']['TwrCp'][i] = data[5] + self.fst_vt['AeroDyn']['TwrCa'][i] = data[6] # Outputs f.readline() @@ -1248,9 +1254,15 @@ def read_AeroDynBlade(self): self.fst_vt['AeroDynBlade']['BlTwist'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] self.fst_vt['AeroDynBlade']['BlChord'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] self.fst_vt['AeroDynBlade']['BlAFID'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] + self.fst_vt['AeroDynBlade']['t_c'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] self.fst_vt['AeroDynBlade']['BlCb'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] self.fst_vt['AeroDynBlade']['BlCenBn'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] self.fst_vt['AeroDynBlade']['BlCenBt'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] + self.fst_vt['AeroDynBlade']['BlCpn'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] + self.fst_vt['AeroDynBlade']['BlCpt'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] + self.fst_vt['AeroDynBlade']['BlCan'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] + self.fst_vt['AeroDynBlade']['BlCat'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] + self.fst_vt['AeroDynBlade']['BlCam'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] for i in range(self.fst_vt['AeroDynBlade']['NumBlNds']): data = [float(val) for val in f.readline().split()] self.fst_vt['AeroDynBlade']['BlSpn'][i] = data[0] @@ -1260,14 +1272,26 @@ def read_AeroDynBlade(self): self.fst_vt['AeroDynBlade']['BlTwist'][i] = data[4] self.fst_vt['AeroDynBlade']['BlChord'][i] = data[5] self.fst_vt['AeroDynBlade']['BlAFID'][i] = data[6] - if len(data) == 9: - self.fst_vt['AeroDynBlade']['BlCb'][i] = data[7] - self.fst_vt['AeroDynBlade']['BlCenBn'][i] = data[8] - self.fst_vt['AeroDynBlade']['BlCenBt'][i] = data[9] + if len(data) == 16: + self.fst_vt['AeroDynBlade']['t_c'][i] = data[7] + self.fst_vt['AeroDynBlade']['BlCb'][i] = data[8] + self.fst_vt['AeroDynBlade']['BlCenBn'][i] = data[9] + self.fst_vt['AeroDynBlade']['BlCenBt'][i] = data[10] + self.fst_vt['AeroDynBlade']['BlCpn'][i] = data[11] + self.fst_vt['AeroDynBlade']['BlCpt'][i] = data[12] + self.fst_vt['AeroDynBlade']['BlCan'][i] = data[13] + self.fst_vt['AeroDynBlade']['BlCat'][i] = data[14] + self.fst_vt['AeroDynBlade']['BlCam'][i] = data[15] else: + self.fst_vt['AeroDynBlade']['t_c'][i] = 0.0 self.fst_vt['AeroDynBlade']['BlCb'][i] = 0.0 self.fst_vt['AeroDynBlade']['BlCenBn'][i] = 0.0 self.fst_vt['AeroDynBlade']['BlCenBt'][i] = 0.0 + self.fst_vt['AeroDynBlade']['BlCpn'][i] = 0.0 + self.fst_vt['AeroDynBlade']['BlCpt'][i] = 0.0 + self.fst_vt['AeroDynBlade']['BlCan'][i] = 0.0 + self.fst_vt['AeroDynBlade']['BlCat'][i] = 0.0 + self.fst_vt['AeroDynBlade']['BlCam'][i] = 0.0 f.close() diff --git a/openfast_io/openfast_io/FAST_writer.py b/openfast_io/openfast_io/FAST_writer.py index e993752f1e..301a0832ea 100644 --- a/openfast_io/openfast_io/FAST_writer.py +++ b/openfast_io/openfast_io/FAST_writer.py @@ -252,7 +252,10 @@ def write_MainInput(self): f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['TMax'], 'TMax', '- Total run time (s)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['DT'], 'DT', '- Recommended module time step (s)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['InterpOrder'], 'InterpOrder', '- Interpolation order for input/output time history (-) {1=linear, 2=quadratic}\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['NumCrctn'], 'NumCrctn', '- Number of correction iterations (-) {0=explicit calculation, i.e., no corrections}\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['NumCrctn'], 'NumCrctn', '- Numerical damping parameter for tight coupling generalized-alpha integrator (-) [0.0 to 1.0]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['RhoInf'], 'RhoInf', '- Convergence iteration error tolerance for tight coupling generalized alpha integrator (-)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['ConvTol'], 'ConvTol', '- Maximum number of convergence iterations for tight coupling generalized alpha integrator (-)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['MaxConvIter'], 'MaxConvIter', '- Number of correction iterations (-) {0=explicit calculation, i.e., no corrections}\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['DT_UJac'], 'DT_UJac', '- Time between calls to get Jacobians (s)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['UJacSclFact'], 'UJacSclFact', '- Scaling factor used in Jacobians (-)\n')) f.write('---------------------- FEATURE SWITCHES AND FLAGS ------------------------------\n') @@ -890,7 +893,6 @@ def write_AeroDyn(self): f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['TwrShadow'], 'TwrShadow', '- Calculate tower influence on wind based on downstream tower shadow (switch) {0=none, 1=Powles model, 2=Eames model}\n')) f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['TwrAero'], 'TwrAero', '- Calculate tower aerodynamic loads? (flag)\n')) f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['CavitCheck'], 'CavitCheck', '- Perform cavitation check? (flag) [UA_Mod must be 0 when CavitCheck=true]\n')) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['Buoyancy'], 'Buoyancy', '- Include buoyancy effects? (flag)\n')) f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['NacelleDrag'], 'NacelleDrag', '- Include Nacelle Drag effects? (flag)\n')) f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['CompAA'], 'CompAA', '- Flag to compute AeroAcoustics calculation [used only when Wake_Mod = 1 or 2]\n')) f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['AA_InputFile'], 'AA_InputFile', '- AeroAcoustics input file [used only when CompAA=true]\n')) @@ -954,10 +956,10 @@ def write_AeroDyn(self): f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['AeroDyn']['ADBlFile1']+'"', 'ADBlFile(1)', '- Name of file containing distributed aerodynamic properties for Blade #1 (-)\n')) f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['AeroDyn']['ADBlFile2']+'"', 'ADBlFile(2)', '- Name of file containing distributed aerodynamic properties for Blade #2 (-) [unused if NumBl < 2]\n')) f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['AeroDyn']['ADBlFile3']+'"', 'ADBlFile(3)', '- Name of file containing distributed aerodynamic properties for Blade #3 (-) [unused if NumBl < 3]\n')) - f.write('====== Hub Properties ============================================================================== [used only when Buoyancy=True]\n') + f.write('====== Hub Properties ============================================================================== [used only when MHK=1 or 2]\n') f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['VolHub'], 'VolHub', '- Hub volume (m^3)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['HubCenBx'], 'HubCenBx', '- Hub center of buoyancy x direction offset (m)\n')) - f.write('====== Nacelle Properties ========================================================================== [used only when Buoyancy=True or NacelleDrag=True]\n') + f.write('====== Nacelle Properties ========================================================================== [used only when MHK=1 or 2 or when NacelleDrag=True]\n') f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['VolNac'], 'VolNac', '- Nacelle volume (m^3)\n')) f.write('{:<22} {:<11} {:}'.format(', '.join(np.array(self.fst_vt['AeroDyn']['NacCenB'], dtype=str)), 'NacCenB', '- Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates (m)\n')) f.write('{:<22} {:<11} {:}'.format(', '.join(np.array(self.fst_vt['AeroDyn']['NacArea'], dtype=str)), 'NacArea', '- Projected area of the nacelle in X, Y, Z in the nacelle coordinate system (m^2)\n')) @@ -966,12 +968,12 @@ def write_AeroDyn(self): f.write('====== Tail Fin Aerodynamics ========================================================================\n') f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['TFinAero'], 'TFinAero', '- Calculate tail fin aerodynamics model (flag)\n')) f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['AeroDyn']['TFinFile']+'"', 'TFinFile', '- Input file for tail fin aerodynamics [used only when TFinAero=True]\n')) - f.write('====== Tower Influence and Aerodynamics ============================================================ [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True]\n') - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['NumTwrNds'], 'NumTwrNds', '- Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True]\n')) - f.write('TwrElev TwrDiam TwrCd TwrTI TwrCb !TwrTI used only when TwrShadow=2; TwrCb used only when Buoyancy=True\n') - f.write('(m) (m) (-) (-) (-)\n') - for TwrElev, TwrDiam, TwrCd, TwrTI, TwrCb in zip(self.fst_vt['AeroDyn']['TwrElev'], self.fst_vt['AeroDyn']['TwrDiam'], self.fst_vt['AeroDyn']['TwrCd'], self.fst_vt['AeroDyn']['TwrTI'], self.fst_vt['AeroDyn']['TwrCb']): - f.write('{: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} \n'.format(TwrElev, TwrDiam, TwrCd, TwrTI, TwrCb)) + f.write('====== Tower Influence and Aerodynamics ============================================================ [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2]\n') + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['NumTwrNds'], 'NumTwrNds', '- Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or MHK=1 or 2]\n')) + f.write('TwrElev TwrDiam TwrCd TwrTI TwrCb TwrCp TwrCa !TwrTI used only with TwrShadow=2, TwrCb/TwrCp/TwrCa used only with MHK=1 or 2\n') + f.write('(m) (m) (-) (-) (-) (-) (-)\n') + for TwrElev, TwrDiam, TwrCd, TwrTI, TwrCb, TwrCp, TwrCa in zip(self.fst_vt['AeroDyn']['TwrElev'], self.fst_vt['AeroDyn']['TwrDiam'], self.fst_vt['AeroDyn']['TwrCd'], self.fst_vt['AeroDyn']['TwrTI'], self.fst_vt['AeroDyn']['TwrCb'], self.fst_vt['AeroDyn']['TwrCp'], self.fst_vt['AeroDyn']['TwrCa']): + f.write('{: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} \n'.format(TwrElev, TwrDiam, TwrCd, TwrTI, TwrCb, TwrCp, TwrCa)) f.write('====== Outputs ====================================================================================\n') f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['SumPrint'], 'SumPrint', '- Generate a summary file listing input options and interpolated properties to ".AD.sum"? (flag)\n')) f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['NBlOuts'], 'NBlOuts', '- Number of blade node outputs [0 - 9] (-)\n')) @@ -1020,8 +1022,8 @@ def write_AeroDynBlade(self): f.write('Generated with OpenFAST_IO\n') f.write('====== Blade Properties =================================================================\n') f.write('{:<11d} {:<11} {:}'.format(self.fst_vt['AeroDynBlade']['NumBlNds'], 'NumBlNds', '- Number of blade nodes used in the analysis (-)\n')) - f.write(' BlSpn BlCrvAC BlSwpAC BlCrvAng BlTwist BlChord BlAFID BlCb BlCenBn BlCenBt\n') - f.write(' (m) (m) (m) (deg) (deg) (m) (-) (-) (m) (m)\n') + f.write(' BlSpn BlCrvAC BlSwpAC BlCrvAng BlTwist BlChord BlAFID t_c BlCb BlCenBn BlCenBt BlCpn BlCpt BlCan BlCat BlCam\n') + f.write(' (m) (m) (m) (deg) (deg) (m) (-) (-) (-) (m) (m) (-) (-) (-) (-) (-)\n') BlSpn = self.fst_vt['AeroDynBlade']['BlSpn'] BlCrvAC = self.fst_vt['AeroDynBlade']['BlCrvAC'] BlSwpAC = self.fst_vt['AeroDynBlade']['BlSwpAC'] @@ -1029,11 +1031,17 @@ def write_AeroDynBlade(self): BlTwist = self.fst_vt['AeroDynBlade']['BlTwist'] BlChord = self.fst_vt['AeroDynBlade']['BlChord'] BlAFID = self.fst_vt['AeroDynBlade']['BlAFID'] + t_c = self.fst_vt['AeroDynBlade']['t_c'] BlCb = self.fst_vt['AeroDynBlade']['BlCb'] BlCenBn = self.fst_vt['AeroDynBlade']['BlCenBn'] BlCenBt = self.fst_vt['AeroDynBlade']['BlCenBt'] - for Spn, CrvAC, SwpAC, CrvAng, Twist, Chord, AFID, BlCb, BlCenBn, BlCenBt in zip(BlSpn, BlCrvAC, BlSwpAC, BlCrvAng, BlTwist, BlChord, BlAFID, BlCb, BlCenBn, BlCenBt): - f.write('{: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 8d} {: 2.15e} {: 2.15e} {: 2.15e}\n'.format(Spn, CrvAC, SwpAC, CrvAng, Twist, Chord, int(AFID), BlCb, BlCenBn, BlCenBt)) + BlCpn = self.fst_vt['AeroDynBlade']['BlCpn'] + BlCpt = self.fst_vt['AeroDynBlade']['BlCpt'] + BlCan = self.fst_vt['AeroDynBlade']['BlCan'] + BlCat = self.fst_vt['AeroDynBlade']['BlCat'] + BlCam = self.fst_vt['AeroDynBlade']['BlCam'] + for Spn, CrvAC, SwpAC, CrvAng, Twist, Chord, AFID, t_c, BlCb, BlCenBn, BlCenBt, BlCpn, BlCpt, BlCan, BlCat, BlCam in zip(BlSpn, BlCrvAC, BlSwpAC, BlCrvAng, BlTwist, BlChord, BlAFID, t_c, BlCb, BlCenBn, BlCenBt, BlCpn, BlCpt, BlCan, BlCat, BlCam): + f.write('{: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 8d} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e}\n'.format(Spn, CrvAC, SwpAC, CrvAng, Twist, Chord, int(AFID), t_c, BlCb, BlCenBn, BlCenBt, BlCpn, BlCpt, BlCan, BlCat, BlCam)) f.flush() os.fsync(f) diff --git a/openfast_io/openfast_io/tests/test_of_io_pytest.py b/openfast_io/openfast_io/tests/test_of_io_pytest.py index c8ad87742f..9122687e98 100644 --- a/openfast_io/openfast_io/tests/test_of_io_pytest.py +++ b/openfast_io/openfast_io/tests/test_of_io_pytest.py @@ -17,7 +17,7 @@ # Exercising the various OpenFAST modules FOLDERS_TO_RUN = [ "AWT_YFix_WSt" , # "openfast;elastodyn;aerodyn;servodyn" - "AWT_WSt_StartUp_HighSpShutDown" , # "openfast;elastodyn;aerodyn;servodyn" + # "AWT_WSt_StartUp_HighSpShutDown" , # "openfast;elastodyn;aerodyn;servodyn" "AWT_YFree_WSt" , # "openfast;elastodyn;aerodyn;servodyn" "AWT_YFree_WTurb" , # "openfast;elastodyn;aerodyn;servodyn" "AWT_WSt_StartUpShutDown" , # "openfast;elastodyn;aerodyn;servodyn" @@ -334,4 +334,4 @@ def main(): Run the main function if the script is run directly or through VSCode debugger """ - main() \ No newline at end of file + main() diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index 8a67fda02b..8e89d79cfa 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -313,7 +313,7 @@ endfunction(py_openfast_io_library_pytest) # OpenFAST regression tests of_regression("AWT_YFix_WSt" "openfast;elastodyn;aerodyn;servodyn") -of_regression("AWT_WSt_StartUp_HighSpShutDown" "openfast;elastodyn;aerodyn;servodyn") +# of_regression("AWT_WSt_StartUp_HighSpShutDown" "openfast;elastodyn;aerodyn;servodyn") of_regression("AWT_YFree_WSt" "openfast;elastodyn;aerodyn;servodyn") of_regression("AWT_YFree_WTurb" "openfast;elastodyn;aerodyn;servodyn") of_regression("AWT_WSt_StartUpShutDown" "openfast;elastodyn;aerodyn;servodyn") @@ -333,7 +333,7 @@ of_regression("5MW_Land_DLL_WTurb_wNacDrag" "openfast;elastodyn;aerod of_regression("5MW_OC3Mnpl_DLL_WTurb_WavesIrr" "openfast;elastodyn;aerodyn;servodyn;hydrodyn;subdyn;offshore") of_regression("5MW_OC3Mnpl_DLL_WTurb_WavesIrr_Restart" "openfast;elastodyn;aerodyn;servodyn;hydrodyn;subdyn;offshore;restart") of_regression("5MW_OC3Trpd_DLL_WSt_WavesReg" "openfast;elastodyn;aerodyn;servodyn;hydrodyn;subdyn;offshore") -of_regression("5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth" "openfast;elastodyn;aerodyn;servodyn;hydrodyn;subdyn;offshore") +# of_regression("5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth" "openfast;elastodyn;aerodyn;servodyn;hydrodyn;subdyn;offshore") of_regression("5MW_ITIBarge_DLL_WTurb_WavesIrr" "openfast;elastodyn;aerodyn;servodyn;hydrodyn;map;offshore") of_regression("5MW_TLP_DLL_WTurb_WavesIrr_WavesMulti" "openfast;elastodyn;aerodyn;servodyn;hydrodyn;map;offshore") of_regression("5MW_OC3Spar_DLL_WTurb_WavesIrr" "openfast;elastodyn;aerodyn;servodyn;hydrodyn;map;offshore") @@ -397,6 +397,7 @@ of_regression_linear("StC_test_OC4Semi_Linear_Tow" "" "openfas of_regression_linear("WP_Stationary_Linear" "" "openfast;linear;elastodyn") of_regression_linear("5MW_OC3Spar_Linear" "" "openfast;linear;map;hydrodyn") of_regression_linear("5MW_OC3Mnpl_Linear" "" "openfast;linear;hydrodyn;servodyn;moordyn") +# of_regression_linear("MHK_RM1_Floating_Linear" "-highpass=0.05" "openfast;linear;elastodyn;aerodyn;hydrodyn;moordyn;mhk") # FAST Farm regression tests if(BUILD_FASTFARM) diff --git a/reg_tests/executeAerodynRegressionCase.py b/reg_tests/executeAerodynRegressionCase.py index 3c6cbeac8f..61fd73bf8c 100644 --- a/reg_tests/executeAerodynRegressionCase.py +++ b/reg_tests/executeAerodynRegressionCase.py @@ -102,7 +102,6 @@ # create the local output directory and initialize it with input files rtl.copyTree(inputsDirectory, testBuildDirectory, renameDict={'ad_driver.outb':'ad_driver_ref.outb'}) - # , excludeExt=['.out','.outb']) ### Run aerodyn on the test case if not noExec: diff --git a/reg_tests/executeFASTFarmRegressionCase.py b/reg_tests/executeFASTFarmRegressionCase.py index ce092f851d..f8b6dc5287 100644 --- a/reg_tests/executeFASTFarmRegressionCase.py +++ b/reg_tests/executeFASTFarmRegressionCase.py @@ -36,7 +36,7 @@ from errorPlotting import exportCaseSummary ##### Helper functions -excludeExt=['.out','.outb','.ech','.yaml','.sum','.log'] +excludeExt=['.ech','.yaml','.sum','.log'] ##### Main program @@ -125,7 +125,8 @@ # create the local output directory if it does not already exist if not os.path.isdir(testBuildDirectory): - rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt) + rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt, + renameExtDict={'.out':'.ref.out', '.outb':'.ref.outb'}) caseName='FAST.Farm' # for ease of comparison diff --git a/reg_tests/executeOpenfastAeroAcousticRegressionCase.py b/reg_tests/executeOpenfastAeroAcousticRegressionCase.py index e78bee7ba7..ecdae78844 100644 --- a/reg_tests/executeOpenfastAeroAcousticRegressionCase.py +++ b/reg_tests/executeOpenfastAeroAcousticRegressionCase.py @@ -37,7 +37,7 @@ from errorPlotting import exportCaseSummary ##### Helper functions -excludeExt=['.out','.outb','.ech','.yaml','.sum','.log'] +excludeExt=['.ech','.yaml','.sum','.log'] ##### Main program @@ -96,7 +96,8 @@ # create the local output directory if it does not already exist # and initialize it with input files for all test cases if not os.path.isdir(testBuildDirectory): - rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt) + rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt, + renameExtDict={'.out':'.ref.out', '.outb':'.ref.outb'}) ### Run openfast on the test case if not noExec: diff --git a/reg_tests/executeOpenfastCppRegressionCase.py b/reg_tests/executeOpenfastCppRegressionCase.py index 7aaae53217..d00e193373 100644 --- a/reg_tests/executeOpenfastCppRegressionCase.py +++ b/reg_tests/executeOpenfastCppRegressionCase.py @@ -29,7 +29,7 @@ import glob ##### Helper functions -excludeExt=['.out','.outb','.ech','.sum','.log'] +excludeExt=['.ech','.sum','.log'] ##### Main program @@ -101,7 +101,8 @@ shutil.copy2(srcname, dstname) if not os.path.isdir(testBuildDirectory): - rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt) + rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt, + renameExtDict={'.outb':'.ref.outb', '.out':'.ref.out'}) ### Run openfast on the test case if not noExec: @@ -124,7 +125,7 @@ ### Build the filesystem navigation variables for running the regression test localOutFile = os.path.join(testBuildDirectory, "5MW_Land_DLL_WTurb_cpp.outb") -baselineOutFile = os.path.join(inputsDirectory, "5MW_Land_DLL_WTurb_cpp.outb.gold") +baselineOutFile = os.path.join(inputsDirectory, "5MW_Land_DLL_WTurb_cpp.outb") rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) diff --git a/reg_tests/executeOpenfastLinearRegressionCase.py b/reg_tests/executeOpenfastLinearRegressionCase.py index 91f43062b3..8ac8928ffb 100644 --- a/reg_tests/executeOpenfastLinearRegressionCase.py +++ b/reg_tests/executeOpenfastLinearRegressionCase.py @@ -39,7 +39,7 @@ # from weio.fast_linearization_file import FASTLinearizationFile ##### Helper functions -excludeExt=['.out','.outb','.ech','.yaml','.sum','.log','.md'] +excludeExt=['.ech','.yaml','.sum','.log','.md'] def file_line_count(filename): file_handle = open(filename, 'r') @@ -164,7 +164,8 @@ def indent(msg, sindent='\t'): # # Copying the actual test directory # if not os.path.isdir(testBuildDirectory): -rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt, renameExtDict={'.lin':'.ref_lin'}) +rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt, + renameExtDict={'.lin':'.ref_lin', '.out': '.ref.out', '.outb': '.ref.outb'}) ### Run openfast on the test case if not noExec: @@ -432,7 +433,7 @@ def freqFileClose(file_freq_ref,file_freq_new): ErrorsLoc, ElemErrorsLoc = compareLin(f,ff1,ff2) Errors += ErrorsLoc if len(ElemErrorsLoc)>0: - Errors += ElemErrorsLoc[:3] # Just a couple of them + Errors += ElemErrorsLoc[:5] # Just a couple of them freqFileClose(ff1,ff2) diff --git a/reg_tests/executeOpenfastRegressionCase.py b/reg_tests/executeOpenfastRegressionCase.py index ae863d3a46..0d84e76cd7 100644 --- a/reg_tests/executeOpenfastRegressionCase.py +++ b/reg_tests/executeOpenfastRegressionCase.py @@ -37,7 +37,7 @@ from errorPlotting import exportCaseSummary ##### Helper functions -excludeExt=['.out','.outb','.ech','.yaml','.sum','.log'] +excludeExt=['.ech','.yaml','.sum','.log'] ##### Main program @@ -120,7 +120,8 @@ shutil.copy2(srcname, dstname) if not os.path.isdir(testBuildDirectory): - rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt) + rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt, + renameExtDict={'.out': '.ref.out', '.outb': '.ref.outb'}) ### Run openfast on the test case if not noExec: diff --git a/reg_tests/executePythonRegressionCase.py b/reg_tests/executePythonRegressionCase.py index 13ecb5218f..f043a76b8e 100644 --- a/reg_tests/executePythonRegressionCase.py +++ b/reg_tests/executePythonRegressionCase.py @@ -142,12 +142,21 @@ ### Build the filesystem navigation variables for running the regression test localOutFile = os.path.join(testBuildDirectory, caseName + ".outb") baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".outb") +rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) -testInfo = { - "attribute_names": output_channel_names -} +testInfo = {"attribute_names": output_channel_names} testData = openfastlib.output_values + +# Remove columns that shouldn't be compared +for col in 'ConvIter ConvError NumUJac'.split(): + try: + i = testInfo['attribute_names'].index(col) + del testInfo['attribute_names'][i] + testData = np.delete(testData, i, axis=1) + except ValueError as e: + continue + baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) passing_channels = pass_fail.passing_channels(testData.T, baselineData.T, rtol, atol) diff --git a/reg_tests/lib/errorPlotting.py b/reg_tests/lib/errorPlotting.py index 7de955b21b..37b10fe188 100644 --- a/reg_tests/lib/errorPlotting.py +++ b/reg_tests/lib/errorPlotting.py @@ -42,6 +42,23 @@ def _validateAndExpandInputs(argv): def _parseSolution(solution): try: data, info, _ = load_output(solution) + + # Remove solution iteration columns + for col in 'ConvIter ConvError NumUJac'.split(): + + # If column exists, get index + try: + i = info['attribute_names'].index(col) + except ValueError as e: + continue + + # Remove column from data array + data = np.delete(data, i, axis=1) + + # Remove column from attribute names and units + del info['attribute_names'][i] + del info['attribute_units'][i] + return (data, info) except Exception as e: rtl.exitWithError("Error: {}".format(e)) diff --git a/reg_tests/lib/fast_linearization_file.py b/reg_tests/lib/fast_linearization_file.py index bda25b1ba2..a7e89ffacd 100644 --- a/reg_tests/lib/fast_linearization_file.py +++ b/reg_tests/lib/fast_linearization_file.py @@ -112,7 +112,9 @@ def readMat(fid, n, m, name=''): # Read rows from file, raise exception on failure try: - vals = np.genfromtxt(fid, dtype=np.float64, max_rows=n) + vals = np.empty([n,m], np.float64) + for i in range(n): + vals[i,:] = f.readline().split() except: raise Exception('Failed to convert into an array of float the matrix `{}`\n\tin linfile: {}'.format(name, self.filename)) @@ -172,6 +174,9 @@ def readMat(fid, n, m, name=''): self['C'] = readMat(f, ny, nx, 'C') elif line.find('D:')>=0: self['D'] = readMat(f, ny, nu, 'D') + elif line.find('J:')>=0: + _, rows, _, cols = line.split() + self['J'] = readMat(f, int(rows), int(cols), 'J') elif line.find('dUdu:')>=0: self['dUdu'] = readMat(f, nu, nu,'dUdu') elif line.find('dUdy:')>=0: diff --git a/reg_tests/lib/pass_fail.py b/reg_tests/lib/pass_fail.py index 1a9e0f1e75..2c8be35b62 100644 --- a/reg_tests/lib/pass_fail.py +++ b/reg_tests/lib/pass_fail.py @@ -26,7 +26,26 @@ def readFASTOut(fastoutput): try: - return load_output(fastoutput) + # Load output file + data, info, _ = load_output(fastoutput) + + # Remove solution iteration columns + for col in 'ConvIter ConvError NumUJac'.split(): + + # If column exists, get index + try: + i = info['attribute_names'].index(col) + except ValueError as e: + continue + + # Remove column from data array + data = np.delete(data, i, axis=1) + + # Remove column from attribute names and units + del info['attribute_names'][i] + del info['attribute_units'][i] + + return data, info, 1 except Exception as e: rtl.exitWithError("Error: {}".format(e)) @@ -65,7 +84,7 @@ def passing_channels(test, baseline, RTOL_MAGNITUDE, ATOL_MAGNITUDE) -> np.ndarr where_not_nan = ~np.isnan(test) where_not_inf = ~np.isinf(test) - passing_channels = np.all(where_close * where_not_nan * where_not_inf, axis=1) + passing_channels = np.all(where_close & where_not_nan & where_not_inf, axis=1) return passing_channels def maxnorm(data, axis=0): diff --git a/reg_tests/r-test b/reg_tests/r-test index f78149f374..299d9704d5 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit f78149f37477c23b5780d0cb52c198713a96330f +Subproject commit 299d9704d552d47a06465f69af6e66b5eacab40d diff --git a/vs-build-ifx/.gitignore b/vs-build-ifx/.gitignore new file mode 100644 index 0000000000..5253e137da --- /dev/null +++ b/vs-build-ifx/.gitignore @@ -0,0 +1,4 @@ +.vs +*.user +*.u2d +gitVersionInfo.h \ No newline at end of file diff --git a/vs-build-ifx/CreateGitVersion.bat b/vs-build-ifx/CreateGitVersion.bat new file mode 100644 index 0000000000..91647f8e93 --- /dev/null +++ b/vs-build-ifx/CreateGitVersion.bat @@ -0,0 +1,9 @@ +@ECHO off +SET IncludeFile=..\gitVersionInfo.h + + %IncludeFile% +FOR /f %%a IN ('git describe --abbrev^=8 --always --tags --dirty') DO > %IncludeFile% +git describe --abbrev^=8 --always --tags --dirty > NUL +IF %ERRORLEVEL%==0 ( ECHO '>> %IncludeFile% ) else ( ECHO Unversioned from $Format:%H$ '>> %IncludeFile% ) + +EXIT /B 0 \ No newline at end of file diff --git a/vs-build-ifx/OpenFAST.sln b/vs-build-ifx/OpenFAST.sln new file mode 100644 index 0000000000..2992d3d69b --- /dev/null +++ b/vs-build-ifx/OpenFAST.sln @@ -0,0 +1,1266 @@ + +Microsoft Visual Studio Solution File, Format Version 12.00 +# Visual Studio Version 16 +VisualStudioVersion = 16.0.35425.106 +MinimumVisualStudioVersion = 10.0.40219.1 +Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "Registry", "modules\Registry.vcxproj", "{EC73DA51-78CF-41DB-9DFA-88360BF2EA93}" +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDyn", "modules\AeroDyn.vfproj", "{5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "NWTC-Library", "modules\NWTC-Library.vfproj", "{EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}" +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "InflowWind", "modules\InflowWind.vfproj", "{9CB36EC2-18AF-468E-BE43-FE63E383AA3A}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "VersionInfo", "modules\VersionInfo.vfproj", "{12DF411B-C7DA-47BA-BB85-7714D5FD2A16}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "BeamDyn", "modules\BeamDyn.vfproj", "{A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDisk", "modules\AeroDisk.vfproj", "{731C6D0A-CF24-4FD3-ABAC-17F31D97A188}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ElastoDyn", "modules\ElastoDyn.vfproj", "{E8C5BB9B-9709-41FA-B6F2-F334B112663A}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ExternalInflow", "modules\ExternalInflow.vfproj", "{B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} + {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} + {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} + {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} + {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {FE80CE9A-7E16-476D-B63A-F9F870ACB662} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ExtLoads", "modules\ExtLoads.vfproj", "{AD8D7798-F800-4C73-B896-7E48EF1D52D3}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} + {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} + {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} + {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} + {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {FE80CE9A-7E16-476D-B63A-F9F870ACB662} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ExtPtfm", "modules\ExtPtfm.vfproj", "{3000393A-702F-488E-B918-1D37955FA8D3}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "FEAMooring", "modules\FEAMooring.vfproj", "{676276A1-DC23-4287-8386-07076303C39D}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "HydroDyn", "modules\HydroDyn.vfproj", "{1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SeaState", "modules\SeaState.vfproj", "{951A453F-1999-483D-848A-9B63C282F43D}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "IceDyn", "modules\IceDyn.vfproj", "{D029FC73-035C-4EB8-96DA-5B1131706A2D}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "IceFloe", "modules\IceFloe.vfproj", "{FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "MAP", "modules\MAP.vfproj", "{5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "MoorDyn", "modules\MoorDyn.vfproj", "{923F8E1F-F5FC-4572-9C32-94C90F04A5A9}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "MAP-C", "modules\MAP-C.vcxproj", "{471EEB17-A1AA-43B0-ACEE-719B80BB4811}" + ProjectSection(ProjectDependencies) = postProject + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OrcaFlex", "modules\OrcaFlex.vfproj", "{B50C776E-F931-4E83-916F-C4E6977E40A3}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ServoDyn", "modules\ServoDyn.vfproj", "{46EB37F1-EEBA-4F35-A173-A37D42D97B5B}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SimpleElastoDyn", "modules\SimpleElastoDyn.vfproj", "{2467FDD4-622B-4628-993A-73994FB8172E}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SubDyn", "modules\SubDyn.vfproj", "{648CD825-ECB0-46D1-B1AA-A28F5C36CD91}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SuperController", "modules\SuperController.vfproj", "{7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} + {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} + {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} + {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} + {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {FE80CE9A-7E16-476D-B63A-F9F870ACB662} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OpenFAST-Prelib", "modules\OpenFAST-Prelib.vfproj", "{FE80CE9A-7E16-476D-B63A-F9F870ACB662}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} + {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} + {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} + {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "TurbSim", "modules\TurbSim.vfproj", "{916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "WakeDynamics", "modules\WakeDynamics.vfproj", "{029204DD-3D5B-47C6-8CAA-A933886D4674}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ExternalInflow_Types", "modules\ExternalInflow_Types.vfproj", "{3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "ExtLoads_Types", "modules\ExtLoads_Types.vfproj", "{774BDC53-33C4-4926-B01D-DC376DAE055B}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SuperController_Types", "modules\SuperController_Types.vfproj", "{2542E42E-CF7F-48F3-8621-6BCFC61102BF}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} + {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} + {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} + {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} + EndProjectSection +EndProject +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Modules", "Modules", "{272B8080-A022-4F4A-BDD6-835871E44C23}" +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OpenFAST-Library", "modules\OpenFAST-Library.vfproj", "{6906E75C-2A54-431B-A11D-145864FCDD5C}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6} = {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6} + {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} + {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} + {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} + {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} + {AD8D7798-F800-4C73-B896-7E48EF1D52D3} = {AD8D7798-F800-4C73-B896-7E48EF1D52D3} + {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {FE80CE9A-7E16-476D-B63A-F9F870ACB662} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} = {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {029204DD-3D5B-47C6-8CAA-A933886D4674} = {029204DD-3D5B-47C6-8CAA-A933886D4674} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDyn_Inflow", "modules\AeroDyn_Inflow.vfproj", "{ACF05685-6592-462C-A3B3-9CDE2CAFD958}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDyn_Driver_Subs", "modules\AeroDyn_Driver_Subs.vfproj", "{60BA8F27-5C49-42DA-9CE4-F85A8215D02A}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + {ACF05685-6592-462C-A3B3-9CDE2CAFD958} = {ACF05685-6592-462C-A3B3-9CDE2CAFD958} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDyn_Inflow_C_Binding", "modules\AeroDyn_Inflow_C_Binding.vfproj", "{DB03A086-3362-41E5-930A-B151D137ACCF}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A} = {60BA8F27-5C49-42DA-9CE4-F85A8215D02A} + {ACF05685-6592-462C-A3B3-9CDE2CAFD958} = {ACF05685-6592-462C-A3B3-9CDE2CAFD958} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AWAE", "modules\AWAE.vfproj", "{CA8A0366-3C47-439A-8E9A-25BB36E3C10D}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + EndProjectSection +EndProject +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Glue Codes", "Glue Codes", "{D7D6BEC5-A67B-4D15-81F9-D846A7041C5D}" +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OpenFAST", "glue-codes\OpenFAST.vfproj", "{6E5137FC-19EB-4A7F-AAE8-523AAF95A861}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6} = {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6} + {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {D9220A21-8C69-42E4-B085-E5D996B867D9} = {D9220A21-8C69-42E4-B085-E5D996B867D9} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} + {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} + {6906E75C-2A54-431B-A11D-145864FCDD5C} = {6906E75C-2A54-431B-A11D-145864FCDD5C} + {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} + {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} + {ACF05685-6592-462C-A3B3-9CDE2CAFD958} = {ACF05685-6592-462C-A3B3-9CDE2CAFD958} + {AD8D7798-F800-4C73-B896-7E48EF1D52D3} = {AD8D7798-F800-4C73-B896-7E48EF1D52D3} + {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {FE80CE9A-7E16-476D-B63A-F9F870ACB662} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} = {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "FAST.Farm", "glue-codes\FAST.Farm.vfproj", "{4A398285-E3C7-4CD9-8F43-51A017D5A48A}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6} = {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6} + {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {471EEB17-A1AA-43B0-ACEE-719B80BB4811} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + {D9220A21-8C69-42E4-B085-E5D996B867D9} = {D9220A21-8C69-42E4-B085-E5D996B867D9} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} + {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {2542E42E-CF7F-48F3-8621-6BCFC61102BF} + {3000393A-702F-488E-B918-1D37955FA8D3} = {3000393A-702F-488E-B918-1D37955FA8D3} + {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {774BDC53-33C4-4926-B01D-DC376DAE055B} + {6906E75C-2A54-431B-A11D-145864FCDD5C} = {6906E75C-2A54-431B-A11D-145864FCDD5C} + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D} = {CA8A0366-3C47-439A-8E9A-25BB36E3C10D} + {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} + {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {D029FC73-035C-4EB8-96DA-5B1131706A2D} + {ACF05685-6592-462C-A3B3-9CDE2CAFD958} = {ACF05685-6592-462C-A3B3-9CDE2CAFD958} + {AD8D7798-F800-4C73-B896-7E48EF1D52D3} = {AD8D7798-F800-4C73-B896-7E48EF1D52D3} + {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {FE80CE9A-7E16-476D-B63A-F9F870ACB662} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {E8C5BB9B-9709-41FA-B6F2-F334B112663A} + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} = {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} + {676276A1-DC23-4287-8386-07076303C39D} = {676276A1-DC23-4287-8386-07076303C39D} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + {029204DD-3D5B-47C6-8CAA-A933886D4674} = {029204DD-3D5B-47C6-8CAA-A933886D4674} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} + EndProjectSection +EndProject +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Drivers", "Drivers", "{3517E990-350F-4471-A518-8B0BC77CFDDB}" +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDyn_Driver", "drivers\AeroDyn_Driver.vfproj", "{D9220A21-8C69-42E4-B085-E5D996B867D9}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A} = {60BA8F27-5C49-42DA-9CE4-F85A8215D02A} + {ACF05685-6592-462C-A3B3-9CDE2CAFD958} = {ACF05685-6592-462C-A3B3-9CDE2CAFD958} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "BeamDyn_Driver", "drivers\BeamDyn_Driver.vfproj", "{E32296E3-72E8-435B-9BF3-2FAE02189CA5}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "MoorDyn_Driver", "drivers\MoorDyn_Driver.vfproj", "{9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OrcaFlex_Driver", "drivers\OrcaFlex_Driver.vfproj", "{4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {B50C776E-F931-4E83-916F-C4E6977E40A3} = {B50C776E-F931-4E83-916F-C4E6977E40A3} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SeaState_Driver", "drivers\SeaState_Driver.vfproj", "{F861FB71-8FE4-42A5-8FB4-684F60D50B9C}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {951A453F-1999-483D-848A-9B63C282F43D} = {951A453F-1999-483D-848A-9B63C282F43D} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SubDyn_Driver", "drivers\SubDyn_Driver.vfproj", "{09919696-2DC4-48A3-B862-7BBF5CFD59CE}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} + EndProjectSection +EndProject +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SED_Driver", "drivers\SED_Driver.vfproj", "{C271833A-06D0-441D-A5A8-DDAB0AA4740C}" + ProjectSection(ProjectDependencies) = postProject + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} + {2467FDD4-622B-4628-993A-73994FB8172E} = {2467FDD4-622B-4628-993A-73994FB8172E} + EndProjectSection +EndProject +Global + GlobalSection(SolutionConfigurationPlatforms) = preSolution + Debug_Double|x64 = Debug_Double|x64 + Debug_Matlab|x64 = Debug_Matlab|x64 + Debug|x64 = Debug|x64 + Release_Double_OpenMP|x64 = Release_Double_OpenMP|x64 + Release_Double|x64 = Release_Double|x64 + Release_Matlab|x64 = Release_Matlab|x64 + Release_OpenMP|x64 = Release_OpenMP|x64 + Release|x64 = Release|x64 + EndGlobalSection + GlobalSection(ProjectConfigurationPlatforms) = postSolution + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug_Double|x64.ActiveCfg = Debug|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug_Double|x64.Build.0 = Debug|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug_Matlab|x64.ActiveCfg = Debug|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug_Matlab|x64.Build.0 = Debug|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug|x64.ActiveCfg = Debug|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Debug|x64.Build.0 = Debug|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release_Double_OpenMP|x64.ActiveCfg = Release|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release_Double_OpenMP|x64.Build.0 = Release|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release_Double|x64.ActiveCfg = Release|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release_Double|x64.Build.0 = Release|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release_Matlab|x64.ActiveCfg = Release|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release_Matlab|x64.Build.0 = Release|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release_OpenMP|x64.ActiveCfg = Release|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release_OpenMP|x64.Build.0 = Release|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release|x64.ActiveCfg = Release|x64 + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93}.Release|x64.Build.0 = Release|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug|x64.ActiveCfg = Debug|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Debug|x64.Build.0 = Debug|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release_Double|x64.Build.0 = Release_Double|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release|x64.ActiveCfg = Release|x64 + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E}.Release|x64.Build.0 = Release|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug|x64.ActiveCfg = Debug|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Debug|x64.Build.0 = Debug|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release_Double|x64.Build.0 = Release_Double|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release|x64.ActiveCfg = Release|x64 + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9}.Release|x64.Build.0 = Release|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug|x64.ActiveCfg = Debug|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Debug|x64.Build.0 = Debug|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release_Double|x64.Build.0 = Release_Double|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release|x64.ActiveCfg = Release|x64 + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A}.Release|x64.Build.0 = Release|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug|x64.ActiveCfg = Debug|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Debug|x64.Build.0 = Debug|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release_Double|x64.Build.0 = Release_Double|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release|x64.ActiveCfg = Release|x64 + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16}.Release|x64.Build.0 = Release|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug|x64.ActiveCfg = Debug|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Debug|x64.Build.0 = Debug|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release_Double|x64.Build.0 = Release_Double|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release|x64.ActiveCfg = Release|x64 + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D}.Release|x64.Build.0 = Release|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug|x64.ActiveCfg = Debug|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Debug|x64.Build.0 = Debug|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release_Double|x64.Build.0 = Release_Double|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release|x64.ActiveCfg = Release|x64 + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188}.Release|x64.Build.0 = Release|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug|x64.ActiveCfg = Debug|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Debug|x64.Build.0 = Debug|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release_Double|x64.Build.0 = Release_Double|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release|x64.ActiveCfg = Release|x64 + {E8C5BB9B-9709-41FA-B6F2-F334B112663A}.Release|x64.Build.0 = Release|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug|x64.ActiveCfg = Debug|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Debug|x64.Build.0 = Debug|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release_Double|x64.Build.0 = Release_Double|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release|x64.ActiveCfg = Release|x64 + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A}.Release|x64.Build.0 = Release|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug|x64.ActiveCfg = Debug|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Debug|x64.Build.0 = Debug|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release_Double|x64.Build.0 = Release_Double|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release|x64.ActiveCfg = Release|x64 + {AD8D7798-F800-4C73-B896-7E48EF1D52D3}.Release|x64.Build.0 = Release|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Debug|x64.ActiveCfg = Debug|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Debug|x64.Build.0 = Debug|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release_Double|x64.Build.0 = Release_Double|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release|x64.ActiveCfg = Release|x64 + {3000393A-702F-488E-B918-1D37955FA8D3}.Release|x64.Build.0 = Release|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Debug|x64.ActiveCfg = Debug|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Debug|x64.Build.0 = Debug|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Release_Double|x64.Build.0 = Release_Double|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Release|x64.ActiveCfg = Release|x64 + {676276A1-DC23-4287-8386-07076303C39D}.Release|x64.Build.0 = Release|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug|x64.ActiveCfg = Debug|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Debug|x64.Build.0 = Debug|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release_Double|x64.Build.0 = Release_Double|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release|x64.ActiveCfg = Release|x64 + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA}.Release|x64.Build.0 = Release|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Debug|x64.ActiveCfg = Debug|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Debug|x64.Build.0 = Debug|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Release_Double|x64.Build.0 = Release_Double|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Release|x64.ActiveCfg = Release|x64 + {951A453F-1999-483D-848A-9B63C282F43D}.Release|x64.Build.0 = Release|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug|x64.ActiveCfg = Debug|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Debug|x64.Build.0 = Debug|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release_Double|x64.Build.0 = Release_Double|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release|x64.ActiveCfg = Release|x64 + {D029FC73-035C-4EB8-96DA-5B1131706A2D}.Release|x64.Build.0 = Release|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug|x64.ActiveCfg = Debug|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Debug|x64.Build.0 = Debug|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release_Double|x64.Build.0 = Release_Double|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release|x64.ActiveCfg = Release|x64 + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD}.Release|x64.Build.0 = Release|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug|x64.ActiveCfg = Debug|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Debug|x64.Build.0 = Debug|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release_Double|x64.Build.0 = Release_Double|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release|x64.ActiveCfg = Release|x64 + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19}.Release|x64.Build.0 = Release|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug|x64.ActiveCfg = Debug|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Debug|x64.Build.0 = Debug|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release_Double|x64.Build.0 = Release_Double|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release|x64.ActiveCfg = Release|x64 + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9}.Release|x64.Build.0 = Release|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug_Double|x64.ActiveCfg = Debug|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug_Double|x64.Build.0 = Debug|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug_Matlab|x64.ActiveCfg = Debug|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug_Matlab|x64.Build.0 = Debug|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug|x64.ActiveCfg = Debug|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Debug|x64.Build.0 = Debug|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release_Double_OpenMP|x64.ActiveCfg = Release|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release_Double_OpenMP|x64.Build.0 = Release|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release_Double|x64.ActiveCfg = Release|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release_Double|x64.Build.0 = Release|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release_Matlab|x64.ActiveCfg = Release|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release_Matlab|x64.Build.0 = Release|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release_OpenMP|x64.ActiveCfg = Release|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release_OpenMP|x64.Build.0 = Release|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release|x64.ActiveCfg = Release|x64 + {471EEB17-A1AA-43B0-ACEE-719B80BB4811}.Release|x64.Build.0 = Release|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug|x64.ActiveCfg = Debug|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Debug|x64.Build.0 = Debug|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release_Double|x64.Build.0 = Release_Double|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release|x64.ActiveCfg = Release|x64 + {B50C776E-F931-4E83-916F-C4E6977E40A3}.Release|x64.Build.0 = Release|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug|x64.ActiveCfg = Debug|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Debug|x64.Build.0 = Debug|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release_Double|x64.Build.0 = Release_Double|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release|x64.ActiveCfg = Release|x64 + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B}.Release|x64.Build.0 = Release|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Debug|x64.ActiveCfg = Debug|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Debug|x64.Build.0 = Debug|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release_Double|x64.Build.0 = Release_Double|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release|x64.ActiveCfg = Release|x64 + {2467FDD4-622B-4628-993A-73994FB8172E}.Release|x64.Build.0 = Release|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug|x64.ActiveCfg = Debug|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Debug|x64.Build.0 = Debug|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release_Double|x64.Build.0 = Release_Double|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release|x64.ActiveCfg = Release|x64 + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91}.Release|x64.Build.0 = Release|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug|x64.ActiveCfg = Debug|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Debug|x64.Build.0 = Debug|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release_Double|x64.Build.0 = Release_Double|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release|x64.ActiveCfg = Release|x64 + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6}.Release|x64.Build.0 = Release|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug|x64.ActiveCfg = Debug|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Debug|x64.Build.0 = Debug|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release_Double|x64.Build.0 = Release_Double|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release|x64.ActiveCfg = Release|x64 + {FE80CE9A-7E16-476D-B63A-F9F870ACB662}.Release|x64.Build.0 = Release|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug|x64.ActiveCfg = Debug|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Debug|x64.Build.0 = Debug|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release_Double|x64.Build.0 = Release_Double|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release|x64.ActiveCfg = Release|x64 + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE}.Release|x64.Build.0 = Release|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug|x64.ActiveCfg = Debug|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Debug|x64.Build.0 = Debug|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release_Double|x64.Build.0 = Release_Double|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release|x64.ActiveCfg = Release|x64 + {029204DD-3D5B-47C6-8CAA-A933886D4674}.Release|x64.Build.0 = Release|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug|x64.ActiveCfg = Debug|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Debug|x64.Build.0 = Debug|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release_Double|x64.Build.0 = Release_Double|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release|x64.ActiveCfg = Release|x64 + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C}.Release|x64.Build.0 = Release|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug|x64.ActiveCfg = Debug|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Debug|x64.Build.0 = Debug|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release_Double|x64.Build.0 = Release_Double|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release|x64.ActiveCfg = Release|x64 + {774BDC53-33C4-4926-B01D-DC376DAE055B}.Release|x64.Build.0 = Release|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug|x64.ActiveCfg = Debug|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Debug|x64.Build.0 = Debug|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release_Double|x64.Build.0 = Release_Double|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release|x64.ActiveCfg = Release|x64 + {2542E42E-CF7F-48F3-8621-6BCFC61102BF}.Release|x64.Build.0 = Release|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug|x64.ActiveCfg = Debug|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Debug|x64.Build.0 = Debug|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release_Double|x64.Build.0 = Release_Double|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release|x64.ActiveCfg = Release|x64 + {6906E75C-2A54-431B-A11D-145864FCDD5C}.Release|x64.Build.0 = Release|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug|x64.ActiveCfg = Debug|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Debug|x64.Build.0 = Debug|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release_Double|x64.Build.0 = Release_Double|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release|x64.ActiveCfg = Release|x64 + {ACF05685-6592-462C-A3B3-9CDE2CAFD958}.Release|x64.Build.0 = Release|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug|x64.ActiveCfg = Debug|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Debug|x64.Build.0 = Debug|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release_Double|x64.Build.0 = Release_Double|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release|x64.ActiveCfg = Release|x64 + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A}.Release|x64.Build.0 = Release|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug|x64.ActiveCfg = Debug|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Debug|x64.Build.0 = Debug|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release_Double|x64.Build.0 = Release_Double|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release|x64.ActiveCfg = Release|x64 + {DB03A086-3362-41E5-930A-B151D137ACCF}.Release|x64.Build.0 = Release|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug|x64.ActiveCfg = Debug|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Debug|x64.Build.0 = Debug|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release_Double|x64.Build.0 = Release_Double|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release|x64.ActiveCfg = Release|x64 + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D}.Release|x64.Build.0 = Release|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug|x64.ActiveCfg = Debug|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Debug|x64.Build.0 = Debug|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release_Double|x64.Build.0 = Release_Double|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release|x64.ActiveCfg = Release|x64 + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861}.Release|x64.Build.0 = Release|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug|x64.ActiveCfg = Debug|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Debug|x64.Build.0 = Debug|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release_Double|x64.Build.0 = Release_Double|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release|x64.ActiveCfg = Release|x64 + {4A398285-E3C7-4CD9-8F43-51A017D5A48A}.Release|x64.Build.0 = Release|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug|x64.ActiveCfg = Debug|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Debug|x64.Build.0 = Debug|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Double|x64.Build.0 = Release_Double|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release|x64.ActiveCfg = Release|x64 + {D9220A21-8C69-42E4-B085-E5D996B867D9}.Release|x64.Build.0 = Release|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Debug|x64.ActiveCfg = Debug|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Debug|x64.Build.0 = Debug|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Release_Double|x64.Build.0 = Release_Double|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Release|x64.ActiveCfg = Release|x64 + {E32296E3-72E8-435B-9BF3-2FAE02189CA5}.Release|x64.Build.0 = Release|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Debug|x64.ActiveCfg = Debug|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Debug|x64.Build.0 = Debug|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Release_Double|x64.Build.0 = Release_Double|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Release|x64.ActiveCfg = Release|x64 + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53}.Release|x64.Build.0 = Release|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Debug|x64.ActiveCfg = Debug|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Debug|x64.Build.0 = Debug|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Release_Double|x64.Build.0 = Release_Double|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Release|x64.ActiveCfg = Release|x64 + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD}.Release|x64.Build.0 = Release|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Debug|x64.ActiveCfg = Debug|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Debug|x64.Build.0 = Debug|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Release_Double|x64.Build.0 = Release_Double|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Release|x64.ActiveCfg = Release|x64 + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C}.Release|x64.Build.0 = Release|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Debug|x64.ActiveCfg = Debug|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Debug|x64.Build.0 = Debug|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Release_Double|x64.Build.0 = Release_Double|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Release|x64.ActiveCfg = Release|x64 + {09919696-2DC4-48A3-B862-7BBF5CFD59CE}.Release|x64.Build.0 = Release|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Debug|x64.ActiveCfg = Debug|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Debug|x64.Build.0 = Debug|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Release_Double_OpenMP|x64.ActiveCfg = Release_Double_OpenMP|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Release_Double_OpenMP|x64.Build.0 = Release_Double_OpenMP|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Release_Double|x64.Build.0 = Release_Double|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Release|x64.ActiveCfg = Release|x64 + {C271833A-06D0-441D-A5A8-DDAB0AA4740C}.Release|x64.Build.0 = Release|x64 + EndGlobalSection + GlobalSection(SolutionProperties) = preSolution + HideSolutionNode = FALSE + EndGlobalSection + GlobalSection(NestedProjects) = preSolution + {EC73DA51-78CF-41DB-9DFA-88360BF2EA93} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {5ADBD025-C654-42C2-BA7C-10F3C3CEEB0E} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {EAF5E602-E6CD-4194-8CCA-0827AA4CCEC9} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {9CB36EC2-18AF-468E-BE43-FE63E383AA3A} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {12DF411B-C7DA-47BA-BB85-7714D5FD2A16} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {A0BB16B8-FBCD-452A-A644-FDD2B21DD05D} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {731C6D0A-CF24-4FD3-ABAC-17F31D97A188} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {E8C5BB9B-9709-41FA-B6F2-F334B112663A} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {B93E20A0-2230-4A2E-A1A6-DDA3240E8C8A} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {AD8D7798-F800-4C73-B896-7E48EF1D52D3} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {3000393A-702F-488E-B918-1D37955FA8D3} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {676276A1-DC23-4287-8386-07076303C39D} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {1DA9F21A-F9FE-45BC-A1CF-37A22220A9DA} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {951A453F-1999-483D-848A-9B63C282F43D} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {D029FC73-035C-4EB8-96DA-5B1131706A2D} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {FEE80C0E-EF4F-459D-85F9-D7C53B633DBD} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {5F0B72CC-2FBA-4BCF-AB9E-9968A848BC19} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {923F8E1F-F5FC-4572-9C32-94C90F04A5A9} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {471EEB17-A1AA-43B0-ACEE-719B80BB4811} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {B50C776E-F931-4E83-916F-C4E6977E40A3} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {46EB37F1-EEBA-4F35-A173-A37D42D97B5B} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {2467FDD4-622B-4628-993A-73994FB8172E} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {648CD825-ECB0-46D1-B1AA-A28F5C36CD91} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {7FA44210-FE1C-4D7B-9C52-A7A1BB6B96D6} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {FE80CE9A-7E16-476D-B63A-F9F870ACB662} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {916D9DF0-7D5B-4AC3-B488-69F4FD99F6FE} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {029204DD-3D5B-47C6-8CAA-A933886D4674} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {3C27CA2D-259A-4A45-AA19-DB64F44FBE3C} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {774BDC53-33C4-4926-B01D-DC376DAE055B} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {2542E42E-CF7F-48F3-8621-6BCFC61102BF} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {6906E75C-2A54-431B-A11D-145864FCDD5C} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {ACF05685-6592-462C-A3B3-9CDE2CAFD958} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {60BA8F27-5C49-42DA-9CE4-F85A8215D02A} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {DB03A086-3362-41E5-930A-B151D137ACCF} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {CA8A0366-3C47-439A-8E9A-25BB36E3C10D} = {272B8080-A022-4F4A-BDD6-835871E44C23} + {6E5137FC-19EB-4A7F-AAE8-523AAF95A861} = {D7D6BEC5-A67B-4D15-81F9-D846A7041C5D} + {4A398285-E3C7-4CD9-8F43-51A017D5A48A} = {D7D6BEC5-A67B-4D15-81F9-D846A7041C5D} + {D9220A21-8C69-42E4-B085-E5D996B867D9} = {3517E990-350F-4471-A518-8B0BC77CFDDB} + {E32296E3-72E8-435B-9BF3-2FAE02189CA5} = {3517E990-350F-4471-A518-8B0BC77CFDDB} + {9E1FBABD-B8BD-450F-B53D-72FEE6E78C53} = {3517E990-350F-4471-A518-8B0BC77CFDDB} + {4CE0CEBB-4A29-4E09-8EF5-240C46343ECD} = {3517E990-350F-4471-A518-8B0BC77CFDDB} + {F861FB71-8FE4-42A5-8FB4-684F60D50B9C} = {3517E990-350F-4471-A518-8B0BC77CFDDB} + {09919696-2DC4-48A3-B862-7BBF5CFD59CE} = {3517E990-350F-4471-A518-8B0BC77CFDDB} + {C271833A-06D0-441D-A5A8-DDAB0AA4740C} = {3517E990-350F-4471-A518-8B0BC77CFDDB} + EndGlobalSection + GlobalSection(ExtensibilityGlobals) = postSolution + SolutionGuid = {B362252D-3254-4C68-B527-CC85CE3CCF75} + EndGlobalSection +EndGlobal diff --git a/vs-build-ifx/RunRegistry.bat b/vs-build-ifx/RunRegistry.bat new file mode 100644 index 0000000000..59312201b0 --- /dev/null +++ b/vs-build-ifx/RunRegistry.bat @@ -0,0 +1,371 @@ +@ECHO OFF + +set lines======================================================================= +echo %lines% +IF "%1"=="" ( +ECHO. +ECHO The calling syntax for this script is +ECHO RunRegistry ModuleName [FAST_Root_Loc] +ECHO. +GOTO Done +) + + +REM ---------------------------------------------------------------------------- +REM ------------------------- LOCAL PATHS -------------------------------------- +REM ---------------------------------------------------------------------------- +REM -- USERS MAY EDIT THESE PATHS TO POINT TO FOLDERS ON THEIR LOCAL MACHINES. - +REM -- NOTE: do not use quotation marks around the path names!!!! -------------- +REM ---------------------------------------------------------------------------- +REM ---------------------------------------------------------------------------- +SET Root_Loc=..\.. +IF not "%2"=="" SET Root_Loc=%2 + +SET Modules_Loc=%Root_Loc%\modules +SET Registry=..\..\build\bin\Registry.exe +SET FAST_Loc=%Modules_Loc%\openfast-library\src +SET ED_Loc=%Modules_Loc%\elastodyn\src +SET SED_Loc=%Modules_Loc%\simple-elastodyn\src +SET IfW_Loc=%Modules_Loc%\inflowwind\src +SET HD_Loc=%Modules_Loc%\hydrodyn\src +SET SEAST_Loc=%Modules_Loc%\seastate\src +SET SD_Loc=%Modules_Loc%\subdyn\src +SET MAP_Loc=%Modules_Loc%\map\src +SET FEAM_Loc=%Modules_Loc%\feamooring\src +SET IceF_Loc=%Modules_Loc%\icefloe\src\interfaces\FAST +SET IceD_Loc=%Modules_Loc%\icedyn\src +SET MD_Loc=%Modules_Loc%\moordyn\src +SET ExtInfw_Loc=%Modules_Loc%\externalinflow\src +SET ExtLoads_Loc=%Modules_Loc%\extloads\src +SET Orca_Loc=%Modules_Loc%\orcaflex-interface\src +SET NWTC_Lib_Loc=%Modules_Loc%\nwtc-library\src +SET ExtPtfm_Loc=%Modules_Loc%\extptfm\src +SET AD_Loc=%Modules_Loc%\aerodyn\src +SET SrvD_Loc=%Modules_Loc%\servodyn\src +SET BD_Loc=%Modules_Loc%\beamdyn\src +SET SC_Loc=%Modules_Loc%\supercontroller\src +SET ADsk_Loc=%Modules_Loc%\aerodisk\src + +SET LD_Loc=%Modules_Loc%\lindyn\src + +SET AWAE_Loc=%Modules_Loc%\awae\src +SET WD_Loc=%Modules_Loc%\wakedynamics\src +SET Farm_Loc=%Root_Loc%\glue-codes\fast-farm\src + +SET ALL_FAST_Includes=-I "%FAST_Loc%" -I "%NWTC_Lib_Loc%" -I "%ED_Loc%" -I "%SED_Loc%" -I^ + "%SrvD_Loc%" -I "%AD_Loc%" -I "%ADsk_Loc%" -I "%BD_Loc%" -I "%SC_Loc%" -I^ + "%IfW_Loc%" -I "%SD_Loc%" -I "%HD_Loc%" -I "%SEAST_Loc%" -I "%MAP_Loc%" -I "%FEAM_Loc%" -I^ + "%IceF_Loc%" -I "%IceD_Loc%" -I "%MD_Loc%" -I "%ExtInfw_Loc%" -I "%Orca_Loc%" -I "%ExtPtfm_Loc%" -I "%ExtLoads_Loc%" + + +SET ModuleName=%1 + +GOTO %ModuleName% + +REM ---------------------------------------------------------------------------- +REM ---------------- RUN THE REGISTRY TO AUTO-GENERATE FILES ------------------- +REM ---------------------------------------------------------------------------- +:NWTC_Lib +SET CURR_LOC=%NWTC_Lib_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\Registry_NWTC_Library_base.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap +GOTO checkError + +:MAP +SET CURR_LOC=%MAP_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -ccode -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" +:: %REGISTRY% "%CURR_LOC%\MAP_Fortran_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap +GOTO checkError + +:MAP_Fortran +SET CURR_LOC=%MAP_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap +GOTO checkError + +:FAST +SET CURR_LOC=%FAST_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\FAST_Registry.txt" %ALL_FAST_Includes% -noextrap -O "%Output_Loc%" +GOTO checkError + +:Glue +SET CURR_LOC=%FAST_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\Glue_Registry.txt" %ALL_FAST_Includes% -noextrap -O "%Output_Loc%" +GOTO checkError + +:BeamDyn +SET CURR_LOC=%BD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\Registry_BeamDyn.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" +GOTO checkError + +:SuperController +SET CURR_LOC=%SC_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\SuperController_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" -ccode +GOTO checkError + +:SCDataEx: +SET CURR_LOC=%SC_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\SC_DataEx_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" -ccode -noextrap +GOTO checkError + + +:ElastoDyn +SET CURR_LOC=%ED_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" +GOTO checkError + +:SimpleElastoDyn +SET CURR_LOC=%SED_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\SED_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" +GOTO checkError + +:StrucCtrl +:ServoDyn +SET CURR_LOC=%SrvD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" +GOTO checkError + +:Lidar +:InflowWind +SET CURR_LOC=%IfW_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" +GOTO checkError + +:IfW_FlowField +:InflowWind_IO +SET CURR_LOC=%IfW_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -noextrap -O "%Output_Loc%" +GOTO checkError + +:ExternalInflow +SET CURR_LOC=%ExtInfw_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%IfW_Loc%" -ccode -O "%Output_Loc%" +GOTO checkError + +:ExtLoads +SET CURR_LOC=%ExtLoads_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -I "%IfW_Loc%" -O "%Output_Loc%" +GOTO checkError + +:ExtLoadsDX +SET CURR_LOC=%ExtLoads_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -ccode -O "%Output_Loc%" +GOTO checkError + +:AeroDyn +:BEMT +:DBEMT +SET CURR_LOC=%AD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%IfW_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" +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 "%IfW_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap +GOTO checkError + +:ADI +SET CURR_LOC=%AD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\AeroDyn_Inflow_Registry.txt" -I "%NWTC_Lib_Loc%" -I %IfW_Loc% -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap +GOTO checkError + + +:AFI +SET CURR_LOC=%AD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\AirfoilInfo_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap +GOTO checkError + +:UA +SET CURR_LOC=%AD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\UnsteadyAero_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" +GOTO checkError + +:LD +SET CURR_LOC=%LD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\LinDyn_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" +GOTO checkError + +:FVW +SET CURR_LOC=%AD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\FVW_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" +GOTO checkError + +:AA +SET CURR_LOC=%AD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\AeroAcoustics_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap +GOTO checkError + +:HydroDyn +:SS_Excitation +:SS_Radiation +:Conv_Radiation +:WAMIT +:WAMIT2 +:Morison +SET CURR_LOC=%HD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -I "%SEAST_Loc%" -O "%Output_Loc%" +GOTO checkError + +:SeaState +:Current +:Waves +:Waves2 +:SeaSt_WaveField + +SET CURR_LOC=%SEAST_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -noextrap -O "%Output_Loc%" +GOTO checkError + +:SubDyn +SET CURR_LOC=%SD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" +GOTO checkError + +:FEAMooring +SET CURR_LOC=%FEAM_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\FEAM_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" +GOTO checkError + +:MoorDyn +SET CURR_LOC=%MD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" +GOTO checkError + +:IceFloe +SET CURR_LOC=%IceF_Loc% +SET Output_Loc=%Modules_Loc%\icefloe\src\icefloe +%REGISTRY% "%CURR_LOC%\%ModuleName%_FASTRegistry.inp" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" +GOTO checkError + +:IceDyn +SET CURR_LOC=%IceD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\Registry_%ModuleName%.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" +GOTO checkError + +:OrcaFlexInterface +SET CURR_LOC=%Orca_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" +GOTO checkError + +:ExtPtfm_MCKF +SET CURR_LOC=%ExtPtfm_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" +GOTO checkError + +:FarmDriver +SET CURR_LOC=%Farm_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\FAST_Farm_Registry.txt" -I %WD_Loc% -I %AWAE_Loc% -I %Farm_Loc% %ALL_FAST_INCLUDES% -noextrap -O "%Output_Loc%" +GOTO checkError + +:FASTWrapper +SET CURR_LOC=%Farm_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\FASTWrapper_Registry.txt" -I %NWTC_Lib_Loc% %ALL_FAST_INCLUDES% -noextrap -O "%Output_Loc%" +GOTO checkError + +:WakeDynamics +SET CURR_LOC=%WD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\WakeDynamics_Registry.txt" -I %NWTC_Lib_Loc% -noextrap -O "%Output_Loc%" +GOTO checkError + +:AWAE +SET CURR_LOC=%AWAE_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\AWAE_Registry.txt" -I %NWTC_Lib_Loc% -I %IfW_Loc% -noextrap -O "%Output_Loc%" +GOTO checkError + +:AeroDisk +SET CURR_LOC=%ADsk_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\AeroDisk_Registry.txt" -I %NWTC_Lib_Loc% -I %IfW_Loc% -I "%CURR_LOC%" -O "%Output_Loc%" +GOTO checkError + +:Version +DEL "%Root_Loc%\VersionInfo.obj" "%Root_Loc%\versioninfo.mod" +GOTO end + +:checkError +ECHO. +IF %ERRORLEVEL% NEQ 0 ( +ECHO Error running FAST Registry for %ModuleName%. +) ELSE ( +ECHO Registry for %ModuleName% completed. +REM COPY /Y "%ModuleName%_Types.f90" "%CURR_LOC%" +rem IF /I "%ModuleName%"=="MAP" COPY /Y "%ModuleName%_Types.h" "%CURR_LOC%" +) + +:end +REM ---------------------------------------------------------------------------- +REM ------------------------- CLEAR MEMORY ------------------------------------- +REM ---------------------------------------------------------------------------- +ECHO.  + +SET ModuleName= +SET CURR_LOC= + +SET Root_Loc= +SET Output_Loc= + +SET Subs_Loc= +SET FAST_Loc= +SET Registry= + +SET ED_Loc= +SET SED_Loc= +SET BD_Loc= +SET IfW_Loc= +SET HD_Loc= +SET SD_Loc= +SET MAP_Loc= +SET FEAM_Loc= +SET IceF_Loc= +SET IceD_Loc= +SET MD_Loc= +SET ExtInfw_Loc= +SET Orca_Loc= +SET NWTC_Lib_Loc= +SET ExtPtfm_Loc= +SET AD_Loc= +SET ADsk_Loc= +SET SrvD_Loc= + +SET MAP_Loc= +SET ALL_FAST_Includes= + +:Done +echo %lines% +set lines= + +:PathsOnly diff --git a/vs-build-ifx/drivers/AeroDyn_Driver.vfproj b/vs-build-ifx/drivers/AeroDyn_Driver.vfproj new file mode 100644 index 0000000000..6d8ebb3078 --- /dev/null +++ b/vs-build-ifx/drivers/AeroDyn_Driver.vfproj @@ -0,0 +1,104 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/drivers/BeamDyn_Driver.vfproj b/vs-build-ifx/drivers/BeamDyn_Driver.vfproj new file mode 100644 index 0000000000..f187f1e901 --- /dev/null +++ b/vs-build-ifx/drivers/BeamDyn_Driver.vfproj @@ -0,0 +1,104 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/drivers/MoorDyn_Driver.vfproj b/vs-build-ifx/drivers/MoorDyn_Driver.vfproj new file mode 100644 index 0000000000..d5021c26f1 --- /dev/null +++ b/vs-build-ifx/drivers/MoorDyn_Driver.vfproj @@ -0,0 +1,104 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/drivers/OrcaFlex_Driver.vfproj b/vs-build-ifx/drivers/OrcaFlex_Driver.vfproj new file mode 100644 index 0000000000..36b1620b22 --- /dev/null +++ b/vs-build-ifx/drivers/OrcaFlex_Driver.vfproj @@ -0,0 +1,105 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/drivers/SED_Driver.vfproj b/vs-build-ifx/drivers/SED_Driver.vfproj new file mode 100644 index 0000000000..437ed0255c --- /dev/null +++ b/vs-build-ifx/drivers/SED_Driver.vfproj @@ -0,0 +1,105 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/drivers/SeaState_Driver.vfproj b/vs-build-ifx/drivers/SeaState_Driver.vfproj new file mode 100644 index 0000000000..f32dfc4dac --- /dev/null +++ b/vs-build-ifx/drivers/SeaState_Driver.vfproj @@ -0,0 +1,103 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/drivers/SubDyn_Driver.vfproj b/vs-build-ifx/drivers/SubDyn_Driver.vfproj new file mode 100644 index 0000000000..a4ceb778cf --- /dev/null +++ b/vs-build-ifx/drivers/SubDyn_Driver.vfproj @@ -0,0 +1,103 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/glue-codes/FAST.Farm.vfproj b/vs-build-ifx/glue-codes/FAST.Farm.vfproj new file mode 100644 index 0000000000..e7cbc0977a --- /dev/null +++ b/vs-build-ifx/glue-codes/FAST.Farm.vfproj @@ -0,0 +1,112 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/glue-codes/OpenFAST.vfproj b/vs-build-ifx/glue-codes/OpenFAST.vfproj new file mode 100644 index 0000000000..cad33ce4b9 --- /dev/null +++ b/vs-build-ifx/glue-codes/OpenFAST.vfproj @@ -0,0 +1,103 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/AWAE.vfproj b/vs-build-ifx/modules/AWAE.vfproj new file mode 100644 index 0000000000..941b46eef3 --- /dev/null +++ b/vs-build-ifx/modules/AWAE.vfproj @@ -0,0 +1,101 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/AeroDisk.vfproj b/vs-build-ifx/modules/AeroDisk.vfproj new file mode 100644 index 0000000000..7b472d8789 --- /dev/null +++ b/vs-build-ifx/modules/AeroDisk.vfproj @@ -0,0 +1,126 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/AeroDyn.vfproj b/vs-build-ifx/modules/AeroDyn.vfproj new file mode 100644 index 0000000000..b1fcd4835e --- /dev/null +++ b/vs-build-ifx/modules/AeroDyn.vfproj @@ -0,0 +1,305 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/AeroDyn_Driver_Subs.vfproj b/vs-build-ifx/modules/AeroDyn_Driver_Subs.vfproj new file mode 100644 index 0000000000..a9e11eb349 --- /dev/null +++ b/vs-build-ifx/modules/AeroDyn_Driver_Subs.vfproj @@ -0,0 +1,124 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/AeroDyn_Inflow.vfproj b/vs-build-ifx/modules/AeroDyn_Inflow.vfproj new file mode 100644 index 0000000000..97c709c2e3 --- /dev/null +++ b/vs-build-ifx/modules/AeroDyn_Inflow.vfproj @@ -0,0 +1,123 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/AeroDyn_Inflow_C_Binding.vfproj b/vs-build-ifx/modules/AeroDyn_Inflow_C_Binding.vfproj new file mode 100644 index 0000000000..5566853f5d --- /dev/null +++ b/vs-build-ifx/modules/AeroDyn_Inflow_C_Binding.vfproj @@ -0,0 +1,103 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/BeamDyn.vfproj b/vs-build-ifx/modules/BeamDyn.vfproj new file mode 100644 index 0000000000..75ba5d0920 --- /dev/null +++ b/vs-build-ifx/modules/BeamDyn.vfproj @@ -0,0 +1,126 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/ElastoDyn.vfproj b/vs-build-ifx/modules/ElastoDyn.vfproj new file mode 100644 index 0000000000..4ba3515068 --- /dev/null +++ b/vs-build-ifx/modules/ElastoDyn.vfproj @@ -0,0 +1,126 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/ExtLoads.vfproj b/vs-build-ifx/modules/ExtLoads.vfproj new file mode 100644 index 0000000000..3b91dac662 --- /dev/null +++ b/vs-build-ifx/modules/ExtLoads.vfproj @@ -0,0 +1,96 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/ExtLoads_Types.vfproj b/vs-build-ifx/modules/ExtLoads_Types.vfproj new file mode 100644 index 0000000000..d192c80065 --- /dev/null +++ b/vs-build-ifx/modules/ExtLoads_Types.vfproj @@ -0,0 +1,151 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/ExtPtfm.vfproj b/vs-build-ifx/modules/ExtPtfm.vfproj new file mode 100644 index 0000000000..f42b6b254b --- /dev/null +++ b/vs-build-ifx/modules/ExtPtfm.vfproj @@ -0,0 +1,126 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/ExternalInflow.vfproj b/vs-build-ifx/modules/ExternalInflow.vfproj new file mode 100644 index 0000000000..749b1e4a83 --- /dev/null +++ b/vs-build-ifx/modules/ExternalInflow.vfproj @@ -0,0 +1,96 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/ExternalInflow_Types.vfproj b/vs-build-ifx/modules/ExternalInflow_Types.vfproj new file mode 100644 index 0000000000..b89acfedd7 --- /dev/null +++ b/vs-build-ifx/modules/ExternalInflow_Types.vfproj @@ -0,0 +1,124 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/FEAMooring.vfproj b/vs-build-ifx/modules/FEAMooring.vfproj new file mode 100644 index 0000000000..bb4a179466 --- /dev/null +++ b/vs-build-ifx/modules/FEAMooring.vfproj @@ -0,0 +1,125 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/HydroDyn.vfproj b/vs-build-ifx/modules/HydroDyn.vfproj new file mode 100644 index 0000000000..c8d388ebc0 --- /dev/null +++ b/vs-build-ifx/modules/HydroDyn.vfproj @@ -0,0 +1,297 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/IceDyn.vfproj b/vs-build-ifx/modules/IceDyn.vfproj new file mode 100644 index 0000000000..d3915397b1 --- /dev/null +++ b/vs-build-ifx/modules/IceDyn.vfproj @@ -0,0 +1,124 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/IceFloe.vfproj b/vs-build-ifx/modules/IceFloe.vfproj new file mode 100644 index 0000000000..9c27605fd4 --- /dev/null +++ b/vs-build-ifx/modules/IceFloe.vfproj @@ -0,0 +1,136 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/InflowWind.vfproj b/vs-build-ifx/modules/InflowWind.vfproj new file mode 100644 index 0000000000..3e00c229e1 --- /dev/null +++ b/vs-build-ifx/modules/InflowWind.vfproj @@ -0,0 +1,210 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/MAP-C.vcxproj b/vs-build-ifx/modules/MAP-C.vcxproj new file mode 100644 index 0000000000..d3fb4b5a47 --- /dev/null +++ b/vs-build-ifx/modules/MAP-C.vcxproj @@ -0,0 +1,206 @@ + + + + + Debug + Win32 + + + Release + Win32 + + + Debug + x64 + + + Release + x64 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 17.0 + Win32Proj + {471eeb17-a1aa-43b0-acee-719b80bb4811} + MAPC + 10.0 + + + + StaticLibrary + true + v142 + Unicode + + + StaticLibrary + false + v142 + Unicode + + + StaticLibrary + true + v142 + Unicode + + + StaticLibrary + false + v142 + Unicode + + + + + + + + + + + + + + + + + + + + + ..\..\build\lib\ + ..\..\build\$(Platform)\$(Configuration)\$(ProjectName)\ + + + ..\..\build\lib\ + ..\..\build\$(Platform)\$(Configuration)\$(ProjectName)\ + + + + Level3 + true + WIN32;_DEBUG;_LIB;%(PreprocessorDefinitions) + true + Use + pch.h + + + + + true + + + + + Level3 + true + true + true + WIN32;NDEBUG;_LIB;%(PreprocessorDefinitions) + true + Use + pch.h + + + + + true + true + true + + + + + Level3 + true + _DEBUG;_LIB;MAP_DLL_EXPORTS;CMINPACK_NO_DLL;NDEBUG;_WINDOWS;_USRDLL;%(PreprocessorDefinitions) + true + NotUsing + pch.h + true + MultiThreadedDebug + ProgramDatabase + + + + + true + + + true + + + + + Level3 + true + true + true + NDEBUG;_LIB;MAP_DLL_EXPORTS;CMINPACK_NO_DLL;_WINDOWS;_USRDLL;%(PreprocessorDefinitions) + true + NotUsing + pch.h + true + MultiThreaded + + + + + true + true + true + + + true + + + + + + \ No newline at end of file diff --git a/vs-build-ifx/modules/MAP.vfproj b/vs-build-ifx/modules/MAP.vfproj new file mode 100644 index 0000000000..5c16d46fbc --- /dev/null +++ b/vs-build-ifx/modules/MAP.vfproj @@ -0,0 +1,124 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/MoorDyn.vfproj b/vs-build-ifx/modules/MoorDyn.vfproj new file mode 100644 index 0000000000..ad8e0e4183 --- /dev/null +++ b/vs-build-ifx/modules/MoorDyn.vfproj @@ -0,0 +1,132 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/NWTC-Library.vfproj b/vs-build-ifx/modules/NWTC-Library.vfproj new file mode 100644 index 0000000000..7f9b0a2587 --- /dev/null +++ b/vs-build-ifx/modules/NWTC-Library.vfproj @@ -0,0 +1,205 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/OpenFAST-Library.vfproj b/vs-build-ifx/modules/OpenFAST-Library.vfproj new file mode 100644 index 0000000000..69c81ce0b4 --- /dev/null +++ b/vs-build-ifx/modules/OpenFAST-Library.vfproj @@ -0,0 +1,105 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/OpenFAST-Prelib.vfproj b/vs-build-ifx/modules/OpenFAST-Prelib.vfproj new file mode 100644 index 0000000000..f6c207a219 --- /dev/null +++ b/vs-build-ifx/modules/OpenFAST-Prelib.vfproj @@ -0,0 +1,150 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/OrcaFlex.vfproj b/vs-build-ifx/modules/OrcaFlex.vfproj new file mode 100644 index 0000000000..426730a9fe --- /dev/null +++ b/vs-build-ifx/modules/OrcaFlex.vfproj @@ -0,0 +1,123 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/Registry.vcxproj b/vs-build-ifx/modules/Registry.vcxproj new file mode 100644 index 0000000000..544c947e1d --- /dev/null +++ b/vs-build-ifx/modules/Registry.vcxproj @@ -0,0 +1,145 @@ + + + + + Debug + x64 + + + Release + x64 + + + + + + + + + + + + + + + 17.0 + Win32Proj + {ec73da51-78cf-41db-9dfa-88360bf2ea93} + openfastregistry + 10.0 + + + + Application + true + v142 + Unicode + + + Application + true + v142 + Unicode + + + Application + true + v142 + Unicode + + + Application + false + v142 + Unicode + + + Application + false + v142 + Unicode + + + Application + true + v142 + Unicode + + + Application + false + v142 + Unicode + + + v142 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + ..\..\build\bin\ + ..\..\build\$(Platform)\$(Configuration)\$(ProjectName)\ + + + ..\..\build\bin\ + ..\..\build\$(Platform)\$(Configuration)\$(ProjectName)\ + + + + Level3 + true + _DEBUG;_CONSOLE;%(PreprocessorDefinitions) + true + true + + + Console + true + + + + + Level3 + true + true + true + NDEBUG;_CONSOLE;%(PreprocessorDefinitions) + true + true + + + Console + true + true + true + + + + + + \ No newline at end of file diff --git a/vs-build-ifx/modules/SeaState.vfproj b/vs-build-ifx/modules/SeaState.vfproj new file mode 100644 index 0000000000..e2c1b8b50e --- /dev/null +++ b/vs-build-ifx/modules/SeaState.vfproj @@ -0,0 +1,239 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/ServoDyn.vfproj b/vs-build-ifx/modules/ServoDyn.vfproj new file mode 100644 index 0000000000..4d60d4b318 --- /dev/null +++ b/vs-build-ifx/modules/ServoDyn.vfproj @@ -0,0 +1,157 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/SimpleElastoDyn.vfproj b/vs-build-ifx/modules/SimpleElastoDyn.vfproj new file mode 100644 index 0000000000..87977f36ed --- /dev/null +++ b/vs-build-ifx/modules/SimpleElastoDyn.vfproj @@ -0,0 +1,125 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/SubDyn.vfproj b/vs-build-ifx/modules/SubDyn.vfproj new file mode 100644 index 0000000000..4e53f284ec --- /dev/null +++ b/vs-build-ifx/modules/SubDyn.vfproj @@ -0,0 +1,129 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/SuperController.vfproj b/vs-build-ifx/modules/SuperController.vfproj new file mode 100644 index 0000000000..ea23c06e7b --- /dev/null +++ b/vs-build-ifx/modules/SuperController.vfproj @@ -0,0 +1,117 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/SuperController_Types.vfproj b/vs-build-ifx/modules/SuperController_Types.vfproj new file mode 100644 index 0000000000..73950ca231 --- /dev/null +++ b/vs-build-ifx/modules/SuperController_Types.vfproj @@ -0,0 +1,128 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/TurbSim.vfproj b/vs-build-ifx/modules/TurbSim.vfproj new file mode 100644 index 0000000000..2f2181d106 --- /dev/null +++ b/vs-build-ifx/modules/TurbSim.vfproj @@ -0,0 +1,113 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/VersionInfo.vfproj b/vs-build-ifx/modules/VersionInfo.vfproj new file mode 100644 index 0000000000..cb0d8c28db --- /dev/null +++ b/vs-build-ifx/modules/VersionInfo.vfproj @@ -0,0 +1,95 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/modules/WakeDynamics.vfproj b/vs-build-ifx/modules/WakeDynamics.vfproj new file mode 100644 index 0000000000..cf5e3aab82 --- /dev/null +++ b/vs-build-ifx/modules/WakeDynamics.vfproj @@ -0,0 +1,123 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build-ifx/update-vfproj.py b/vs-build-ifx/update-vfproj.py new file mode 100644 index 0000000000..87bbc2cf37 --- /dev/null +++ b/vs-build-ifx/update-vfproj.py @@ -0,0 +1,128 @@ +from pathlib import Path + +import bs4 +import copy + +formatter = bs4.formatter.HTMLFormatter(indent=4) + +options_debug_release = {"Debug": {}, "Release": {}} + +cfg_names = [ + "Debug|x64", + "Debug_Double|x64", + "Debug_Matlab|x64", + "Release|x64", + "Release_Double|x64", + "Release_Matlab|x64", + "Release_OpenMP|x64", + "Release_Double_OpenMP|x64", +] + +for path in Path(".").rglob("*.vfproj"): + + print(path) + with open(path) as fp: + soup = bs4.BeautifulSoup(fp, "xml") + cfgs = soup.find("Configurations") + cfg_map = { + "Debug|x64": cfgs.find("Configuration", Name="Debug|x64"), + "Release|x64": cfgs.find("Configuration", Name="Release|x64"), + } + cfgs.clear() + for cfg_name in cfg_names: + if "Debug" in cfg_name: + cfg = copy.copy(cfg_map["Debug|x64"]) + else: + cfg = copy.copy(cfg_map["Release|x64"]) + cfg["Name"] = cfg_name + + # Get tool elements + compiler_tool = cfg.find("Tool", Name="VFFortranCompilerTool") + linker_tool = cfg.find("Tool", Name="VFLinkerTool") + prebuild_tool = cfg.find("Tool", Name="VFPreBuildEventTool") + + # Compiler tool settings + compiler_tool["Preprocess"] = "preprocessYes" + compiler_tool["MultiProcessorCompilation"] = "true" + compiler_tool["UseMkl"] = "mklSequential" + compiler_tool["WarnUnusedVariables"] = "false" + if "Debug" in cfg["Name"]: + compiler_tool["RuntimeLibrary"] = "rtMultiThreadedDebug" + else: + compiler_tool["RuntimeLibrary"] = "rtMultiThreaded" + + # Determine project type (static lib, shared lib, executable) + if cfg.attrs.get("ConfigurationType", "") == "typeStaticLibrary": + cfg["OutputDirectory"] = "..\\..\\build\\lib" + elif cfg.attrs.get("ConfigurationType", "") == "typeDynamicLibrary": + cfg["OutputDirectory"] = "..\\..\\build\\bin" + if 'Debug' in cfg_name: + compiler_tool["FloatingPointExceptionHandling"] = "fpe0" + linker_tool["StackReserveSize"] = "9999999" + elif linker_tool != None and linker_tool["SubSystem"] == "subSystemConsole": + cfg["OutputDirectory"] = "..\\..\\build\\bin" + if 'Debug' in cfg_name: + compiler_tool["FloatingPointExceptionHandling"] = "fpe0" + linker_tool["StackReserveSize"] = "9999999" + linker_tool['GenerateManifest'] = "false" + else: + print("unknown project type") + continue + + # Set intermediate build directory + cfg["IntermediateDirectory"] = ( + "..\\..\\build\\$(Configuration)_$(Platform)\\$(ProjectName)\\" + ) + + # Preprocessor defines + defines = [] + + # Project specific settings + if "NWTC" in str(path): + # defines.append("HAS_FORTRAN2008_FEATURES") + pass + if "VersionInfo" in str(path): + defines.append("GIT_INCLUDE_FILE='..\\gitVersionInfo.h'") + prebuild_tool["CommandLine"] = "..\\CreateGitVersion.bat" + + # Configuration spectific settings + if "Double" in cfg["Name"]: + compiler_tool["RealKIND"] = "realKIND8" + compiler_tool["DoublePrecisionKIND"] = "doublePrecisionKIND8" + if "NWTC" in str(path): + defines.append("OPENFAST_DOUBLE_PRECISION") + if "OpenMP" in cfg["Name"]: + compiler_tool["OpenMP"] = "OpenMPParallelCode" + compiler_tool["EnableOpenMPSupport"] = "OpenMPParallelCodeIFX" + if "Matlab" in cfg["Name"]: + defines.append("COMPILE_SIMULINK") + defines.append("CONSOLE_FILE") + + # Preprocessor defines + compiler_tool["PreprocessorDefinitions"] = ";".join(defines) + + # Add config to configs + cfgs.append(cfg) + + # Update registry file configurations + for f in soup.find_all("File"): + fcs = f.find_all("FileConfiguration") + if len(fcs) == 0: + continue + fc_base = copy.copy(fcs[0]) + for fc in f.find_all("FileConfiguration"): + fc.decompose() + for cfg_name in cfg_names: + fc = copy.copy(fc_base) + fc["Name"] = cfg_name + f.append(fc) + + # Write file + with open(path, "w") as fp: + for line in soup.prettify().splitlines(): + try: + n = line.index("<") + except: + n = 0 + line = ("\t" * n) + line[n:] + "\n" + fp.write(line) diff --git a/vs-build/MAPlib/MAP_dll.vcxproj b/vs-build/MAPlib/MAP_dll.vcxproj index 4ba5c06d02..68a8c26ffb 100644 --- a/vs-build/MAPlib/MAP_dll.vcxproj +++ b/vs-build/MAPlib/MAP_dll.vcxproj @@ -76,7 +76,7 @@ MAP_$(PlatformName) true ..\..\build\bin\ - $(PlatformName)\$(ConfigurationName) +$(PlatformName)\$(ConfigurationName) false @@ -87,7 +87,7 @@ MAP_$(PlatformName) false ..\..\build\bin\ - $(PlatformName)\$(ConfigurationName) +$(PlatformName)\$(ConfigurationName) @@ -203,4 +203,4 @@ - \ No newline at end of file +